'it  m  -V'WtW 


AD-A260  481 


BRLCB: 

A  Closed-Chamber  Data 
Analysis  Program 

Part  II — ^Theory  and  User’s  Manual 
(Appendices  D-M) 


WiUiam  F.  Oberle 
Douglas  E.  Kooker 


ARL-TR-36 
(Part  II) 


January  1993 


DTIC 

t—  1  r  ^  "T*  tT 


APPROVED  FOR  PUBUC  RELEASE;  DISTKIBirnON  IS  UNUMTTED. 


93-02362 


NOTICES 


Destroy  this  report  when  it  is  no  ionger  needed.  DO  NOT  return  it  to  the  originator. 

Additionai  copies  of  this  report  may  be  obtained  from  the  National  Technical  Information 
Service,  U.S.  Department  of  Commerce.  5285  Port  Royal  Road,  Springfield.  VA  22161. 


The  findings  of  this  report  are  not  to  be  construed  as  an  official  Department  of  the  Army 
position,  unless  so  designated  by  other  authorized  documents. 


The  use  of  trade  names  or  manufacturers’  names  in  this  report  does  not  constitute 
indorsement  of  any  commercial  product. 


REPORT  DOCUMENTATION  PAGE 


form  Approved 
0MB  NO  0704-C188 


PuDtic  reporting  Durdfn  for  thi«  collection  of  mfortnation  n  eitimeted  to  evert^e  t  nour  per  reiponte.  including  tne  time  tor  reviewing  imtructiont.  »e«rching  eiistmg  date  togrcet. 
gathering  ar«d  maintaining  the  data  rteeded.  and  completing  and  leviewir^  the  collection  of  information  Send  conimenu  regarding  thit  Durden  ettimate  or  any  other  atoect  of  tnn 
collection  of  information,  including  suggettiom  for  reducing  thn  Durden  to  Wathmgion  Heaoduartert  Services.  Directorate  for  information  Operations  artd  Reports.  )2tS  jfHersort 
Davis  Highway.  Suite  1204.  Arlington.  VA  22202*4302.  and  to  the  O^iceof  Management  and  Budget.  Paperwora  deduction  Project  (0704*0  IBS).  Washington.  DC  20S03 


1.  AGENCY  USE  ONLY  (leove  blank)  I  2.  REPORT  DATE 


4.  miE  AND  SUBTITLE 

BRLCB:  A  Gosed-Chamber  Data  Analysis  Program 
Part  n — ^Theory  and  User’s  Manual  (Appendices  D-M) 


6.  AUTHOR(S) 

William  Oberie  and  Douglas  Kooka 


3.  REPORT  TYPE  AND  DATES  COVERED 

Final,  October  1990-October  1992 


S.  FUNDING  NUMBERS 

DA311880 

1F2Z9W 

9XDGS3 


7.  PERFORMING  ORGANIZATION  NAME(S)  AND  AOORESS(ES} 


PERFORMING  ORGANIZATION 
REPORT  NUMBER 


9.  SPONSORING /MONITORING  AGENCY  NAME(S)  AND  ADDRESS(ES) 

U.S.  Army  Research  Labofatory 
ATTN:  AMSRL-OP-a-B  (Tech  Ub) 

Aberdeen  Proving  Ground,  MD  2100S-S066 


10.  SPONSORING  /  MONITORING 
AGENCY  REPORT  NUMBER 

ARL-TR-36 
(Part  II) 


12a.  distribution /AVAILABILITY  STATEMENT 


12b.  DISTRIBUTION  CODE 


Approved  for  public  release;  distribution  is  unlimited. 


13.  ABSTRACT  (Maximum  200  words) 


BRLCB  is  a  PC-based  analysis  program  designed  to  perform  all  data  analysis  associated  with  closed  chamber 
experiments.  Included  in  the  program  are  provisions  for  deterred  and  layered  propellants  and  electrothermal-chemical 
augmented  firings.  The  basic  features  of  the  {nogram  and  user’s  guide  ait  presented  and  validated,  and  future  plans  and 
additions  to  the  program  are  outlined. 


14.  SUaJEa  TERMS 


closed  bomb;  closed  chamber,  detened  propellant;  burning  rate;  propellants 


IS.  NUMBER  OF  PAGES 

248 


16.  PRICE  CODE 


17.  SECURITY  CLASSIFICATION  I  IB.  SECURITY  CLASSIFICATION  119.  SECURITY  CLASSIFICATION  I  20.  LIMITATION  OF  ABSTRACT 

OF  REPORT  I  OF  THIS  PAGE  |  OF  ABSTRAa  I 


UNCLASSIFIED 


NSN  7S40.O1-2B0-SS00 


UN(XASSIFIED 


UNCLASSIFIED 


Standard  Form  298  (Rav  2-89) 

araKfiM  w  ANU  Ma  2M-tl 

mio> 


Intentionally  left  blank. 


ii 


TABLE  OF  CONTENTS 


Page 


APPENDIX  D:  LISTING-BATCHHLEBRLCB.BAT  .  137 

APPENDIX  E:  LISTING  -  PROGRAM  MKCHCE.FOR  .  141 

APPENDIX  F;  LISTING  -  PROGRAM  MKMASTER.FOR .  145 

APPENDIX  G:  LISTING  -  PROGRAM  MKGAGE.FOR .  191 

APPENDIX  H:  LISTING  -  PROGRAM  MKPTDATA.FOR .  201 

APPENDIX  I:  LISTING  -  PROGRAM  MKINF.FOR .  231 

APPENDIX  J:  LISTING  -  PROGRAM  MKSMOOTH.FOR .  243 

APPENDIX  K:  LISTING  -  PROGRAM  MKCAL.FOR  .  269 

APPENDIX  L:  LISTING  -  PROGRAM  MKOUT.FOR  .  335 

APPENDIX  M:  SMOOTHING  AND  DIFFERENTIATION  COEmaENTS .  377 

DISTRIBUTION  LIST  .  395 


Accesion  For 


NTIS  CRA&I 

DflC  TAB 

Ur.afinoi];)Cfjcl 

G 

Juilifiaation 

By . 

AvdiUit.-ility 


m 


Hi 


ImiENTIONALLY  LEFT  BLANK. 


IV 


PREFACE 


The  Appendices  (I>-M)  contained  in  this  volume  contain  the  entire  FORTRAN  77  listing  for  the 
program  BRLCB.  Details  concerning  the  program  itself  are  provided  in  the  first  half  of  the  report 
"BRLCB:  A  aosed-Chamber  Data  Analysis  Program,  Part  I — ^Theory  and  User’s  Manual,"  which  is 
published  as  a  separate  volume. 


V 


Intentionally  left  blank. 


VI 


APPENDIX  D: 

LISTING  -  BATCH  HLE  BRLCB.BAT 


137 


Intentionally  left  blank. 


REM  BATCH  FILE  BRLCB.BAT 

ECHO  OFF 

graphics 

mkchce 

opt 
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PROGRAM  MKCHCE 

^  «  4iiti  Hi  *  41 41  *  *  «  *  *  *  «>  *  IX  IK  *  *  **  *  <1 «  *  *  «  *  *»> «  *  »  He  *  «  *  *  «  *  It<  IX  *  <l>  IX  4>  *  *  *  * 


C  VERSION:  3.0;  January  1992 
C  Final  Cleanup,  4  April  1992 

C 

C  Written  By:  William  Oberle;  U.S.  Army  Research  Laboratory 
C 

C  Purpose:  The  purpose  of  this  program  is  to  provide 
C  initial  choices  for  BRLCB  and  create  a 

C  IBM-DOS  batch  file  named  OPT.BAT  to  the 

C  drive  the  program. 


^  *  IX IX  4<  4i  IX  41 4i  4i  IX IX IX IX IX  41 IX IX  4<  4i  4i  4i  IX  41  iX  41 IX IX  4i  41 4i  4iiX  4i  4i  4i  4i  IX IX IX  41 IX IX IX  41 41 IX IX  4<  4i  IX  4i  4i  4<  IX IX IX 


OPEN  (UNIT  =  8.  FILE  =  ’OPT.BAT*) 
REWIND  (8) 

WRITE  (8.  *)  ’ECHO  OFF’ 

CALL  CLEAR 

C  The  main  menu  of  selections  is  written. 


WRITE  (*.  6000) 

6000  FORMAT(20X.’BRLCB  Version  3.0  **  JANUARY  1992’) 
WRITE  (*,  *) 

WRITE  (*.  *) 

WRITE  (*,  6010) 

6010  FORMAT(35X,’Main  Menu’) 

WRITE  (•,  *) 

WRITE  (*.  6020) 

6020  FORMAT(20x,’l.  Create  Master  Information  File’) 

WRITE  (*,  6030) 

6030  FORMAT(20x,’2.  Update  gage  information’) 

WRITE  (*,  6040) 

6040  FORMAT(20x,’3.  Prepare  pressure/time  data’) 

WRITE  (*,  6050) 

6050  FORMAT(20x,’4.  Prepare  firing  information  file’) 

WRITE  (*,  6060) 

6060  FORMAT(20x,’5.  Smooth  pressureAime  data’) 

WRITE  (•.  6070) 

6070  FORMAT(20x,’6.  Perform  data  analysis’) 

WRITE  (*,  6080) 

6080  FORMAT(20x,’7.  Prepare  output’) 

WRITE  (*.  6090) 

6090  FORMAT(20x.’8.  Exit  program’) 

WRITE  (*,  *) 

1000  CONTINUE 

WRITE  (*,  *)  ’Please  Enter  Your  Choice  (1  -  8):  ’ 

READ  (*,  *)  ICHOICE 
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IF  aCHOICE  .GT.  8)  THEN 
WRITE  (*.  *) 

WRITE  (*,  *)  ’The  choice  you  have  made  is  not  between’ 
WRIIE.  (*,  *)  ’1  and  8.  Please  select  again.’ 

GO  TO  1000 
END  IF 

C  The  batch  file  OPT.BAT  is  created  for  the  proper  choice. 

IF  aCHOICE  .EQ.  1)  WRH’E  (8.  *)  ’MKMASTER’ 

IF  (ICHOICE  .EQ.  2)  WRITE  (8,  *)  ’MKGAGE’ 

IF  aCHOICE  .EO.  3)  WRITE  (8.  *)  ’MKPTDATA’ 

IF  (ICHOICE  .EQ.  4)  WRITE  (8.  *)  ’MKENF’ 

IF  aCHOICE  .EQ.  5)  WRITE  (8.  *)  ’MKSMOOTH’ 

Dr  aCHOICE  .EQ.  6)  WRITE  (8,  *)  ’MKCAL’ 

IF  (ICHOICE  .EQ.  7)  WRITE  (8.  *)  ’MKOUT’ 

IF  aCHOICE  .EQ.  8)  GO  TO  1010 
WRITE  (8,  •)  ’BRL’ 

1010  CONTINUE 
CLOSE  (8) 

END 


^  %  iti  *  *  *  *  *  iti4i4i  4i  4. 4>  it<  *  it<  4<  (1>  *  itr  4>  *  >•< «  « Xh  4i «  *  4t  *  «  4t  Ik  %  iti  !«>  it> «  111 «  *  4^  >*>  4>  i«<  >l< 

^4"t«t>4<4'i|<4"l>4<4<«4<4i4i*4i4i4i4i4i  SUBROUTINE  CLEAR******************************** 

^  4<  4<  4<  4<  4i  4<  4<  4t  4<  4i  4>  4<  4i  4<  *  *  4i  4i  4<  4i  4i  4i  4<  4i  4i  4i  4i  4<  4i  4i  4<  4<  4<  4i  4<  4i  4<  4<  4i  4i  4i  4i  4i  4i  4i  4i  4<  Ik  4<  4i  4i  4>  4i  4>  4t  k  4<  4' 4<  4<  4i  4<  4i  4<  4<  4i  4i  4i  If  4< 

SUBROUTINE  CLEAR 
CHARACFER  ST*4 
DATA  ST/’  (2J’/ 

WRITE  (*,  6000)  ST 
6000  FORMAT  (1X.A4) 

RETURN 

END 
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PROGRAM  MKMASTER 

^  *  Di  4i  «***  *  Kiiti  *  i«iti  Id  *  Di  **41 4i  4ti|t  41  *  4<  ****  4>  **  ***  >l<  »"•>  **  1*1  **  Koti*  >!»!<**  4<4i  <«)«•>****  * 

C  Version:  3.0,  January  1992 

C  Written  by:  William  Oberle,  U.S.  Army  Research  Laboratory 


C 

C 

c 

c 

c 

C  Purpose 
C 

c 


Last  Modified:  12/30/91  **  Depth  of  Each  layer  added 
to  P(1.J.2) 

1/19/92  **  Modified  for  homogeneous  grain 
2/8/92:  Cleanup,  hex  grain  fixed 


This  program  is  the  calling  program  to  generate 
a  master  information  file  for  a  series  of  closed 
bomb  chamber  firings. 

^  *  4,1*1  Id  *  4"l>  *  *  *  *  *  <*1  <(i  <*<  *  *  *  *  *  *  d  *  *  **«  Id  If  >•>  *  4>  *  4>  *  *  *  *  *  *  *  *  d  Id  *  *  *  *  d  *  *  *  Id  *  *  4>  *  41  d  *  *  *  *  *  Hod  *  »< 

^  4<  Id  Id  Id  Id  4,  Id  4i  4, 4, 4,  *  4, 4,  Id  4, 4>  4,  Id  4,  Id  4>  4, 4<  4<  4, 4, 4, 4,  *  4, 4, 4, 41 4, 41 4<  •  4, 4>  4, 4,  Id  Id  4i  4>  41 4>  d  4,  Id  Id  4, 4,  Id  Id  4, 4, 4, 4<  4i  4<  4<  4>  4>  Id  4<  4,  Id  Id  Id 

CHARACTER*20  FNAME,  FNAMEl,  A1  (20)*20,  A2  (6)*80.  MARK  (4)*1,  ZZl 
COMMON  A3  (100),  P  (11,  15.  5) 

4<  4>  4, 4<  41 4, 4, 4, 4, 4i  4>  4, 4<  4<  4, 4<  4<  4<  4<  4<  4<  4, 4i  4, 4>  d  Id  4>  4, 4<  4>  4>  4<  4, 4<  4<  4>  4>  4, 4, 4, 4>  4, 4, 4<  4>  4, 4<  4i  4, 4, 4<  4>  4, 4, 4, 4, 4>  4<  41 4, 4>  4>  4>  4<  4, 4, 4>  4, 4<  4< 

^dddddddddddddddddd  INITIALIZATION  OF  ALL  ARRAYS  4,dddddddddddddddddddddd 

^ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 


DO  1000  I  =  1.  20 
Ai  a)  =  ” 

1000  CONTINUE 
DO  10101  =  1,6 
A2  a)  =  ” 

1010  CONTINUE 
DO  1020  I  =  1,  100 


A3  0)  =  0.0 
1020  CONTINUE 
DO  1030  1  =  1.7 
DO  1040  J  =  1.  15 
DO  1050  K=  1.5 


P  (I.  J.  K)  =  0.0 


1050  CONTINUE 
1040  CONTINUE 
1030  CONTINUE 
DO  1060  J  =  1,  15 
P  (8.  J.  1)  =  1. 

P  (8,  J.  2)  =  1. 
1060  CONTINUE 
I4ARK  (1)  =  ’  ’ 
MARK  (2)  =  ” 
MARK  (3)  =  ’  ’ 
MARK  (4)  =  ” 


^d4idd*d4iiddddd4>d4>4idd4>d4iidddddddddd4i4idd4,dddddddddddd4,diddidddddiddddddddidddddd 
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C***********  WRITE  THE  INITIAL  HEADER  INFORMATION  ********************** 

Q*itiiti4i4iitt«i|i4i4<4c***iti4i4ii|i«4i*i|i*iti**4'4i4i*4i4i4r4i**4<4iit>«i*4i*4>*************************** 


1070  CONTINUE 
CALL  CLEAR 
WRITE  (*,  6000) 

6000  FORMATC  ’,20X;BRLCB  **  VERSION  3.0  **  JANUARY  1992’) 
WRITE  (*.  6010) 

WRITE  (*,  6020) 

6010  FORM AT(////,20X, ’Creating  a  Master  Infomation  File’y, 

1  10X,58(’-’)) 

6020  FORMAT(10x,’This  program  will  create  a  master  information’ 

1  y,10x,’file  which  will  contain  information  that  does’, 

2  AlOx.’not  change  from  one  firing  to  the  next’) 

WRITE  (*,  6030) 

6030  FORMAT(///) 


^  *  III  *  4<  *  *  4ii|i  *  *  4,  Ik  i|>  4<  41 1)1  *  «  *  *  <11)1 *  4i  4i  4i  4t  *  4t  *  *  «  *  %  it<  #  4t  *  4> «  *  *  i|>  *  *  4r 


^4141**4.**********  CHECKING  TO  BUILD  FROM  EXISTING  .MAS  FILE  ************* 


^4i4i4i4i4i4<4<4>*4i***4i4i4i**4i4i4i4i4i4<4>4i4i4<4i4i4i4i4i4<****4i4<4i4<4i4i4i**4i4i*4>4i4i4.4>4>4i4i4i4i4i4i4i4i***4i4i4i4< 


WRITE  (*,  *)  ’  Create  .MAS  file  from  existing  file?  [Y/N]’ 

WRITE  (*.  *)  ’  Default:  Y’ 

READ  (*.  5000)  ZZ 
5000  FORMAT(Al) 

IF  ((ZZ  .EQ.  ’  ’)  .OR.  (ZZ  .EQ.  ’Y’)  .OR.  (ZZ  .EQ.  ’y’))  THEN 
WRITE  (*,  *)  ’Enter  the  file  name  of  the  master  file  from’ 

WRITE  (*,  *)  ’which  the  new  master  file  will  be  created.’ 

WRITE  (*,  *)  ’Include  drive  and  file  extension  if  necessary.’ 

READ  (*,  5010)  FNAMEl 
5010  FORMAT(A20) 

OPEN  (UNIT  =  9.  FILE  =  FNAMEl.  STATUS  =  ’OLD’,  ERR  =  1080) 

REWIND  (UNIT  =  9) 

GO  TO  1090 
1080  CONTINUE 
WRITE  (*,  6040) 

6040  FORMAT(20X,’The  indicated  master  file  does  not  exist,  try  again.’) 

PAUSE 
GO  TO  1070 

^4<***4i*4i*4i4i4>4i4i4i4'*************4>*********4>***4i4i4i**4>4<***4<4i***4i4>4i4<4i4i4<4i4i4i4i4i** 

C**********  READING  OLD  MASTER  FILE  TO  BUILD  FROM  ********************** 

^4i4i*4i*****************************4i4i***4i***4i*4i**4i4i*4i*4i4i***¥****4i4i4i**4i4i** 

1090  CONTINUE 
DO  11001=  1,6 
READ  (9.  5020)  A2  0) 

1100  CONTINUE 
5020  FORMAT(A80) 

DO  11101=  1,20 
READ  (9.  5010)  A1  0) 

1110  CONTINUE 
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DO  11201=  1,  100 
READ  (9.  •)  A3  0) 

1120  CONTINUE 
DO  11301=  1,  11 
DO  1140  J=  1,  15 
DO  1150  K=  1,5 
READ  (9.  *)  P  a.  J.  K) 
1150  CONTINUE 
1140  CONTINUE 
1130  CONTINUE 

CLOSE  (UNIT  =  9) 

END  IF 


^  «  *  lit «  «  *  *  Hiili  *  «  *1*  itiik  *  *  *  4>  *  *  *  *  K<  *  «  *  *  4>  *  *  *  »<  4<  *  4>  *  Ik  *  Hi  Di  *  <|i  >(<  *  4i  «  4>  >t<  it<  <t<  * 


^4I*4.||,*4<«4.«***4I4.4.4.  IDENTIFICATION  INFO  MUST  BE  OBTAINED  ***************** 


^  Ik  *  *  «  «  *  «  4i « Ik  *  *  Hi  *  4i  *  If  <•  4i  *  «  *  *  *  «  «  «  *  *  » Ik  *  «  *  *  *  Ik  *  Ik  «  «  4>  4i  *  4>  It  *  *  *  *  *  Ik  *  Ik  *  *  *  *  Ik  Ik  *  «  *  *  *  *  Ik  *  Ik  * 


CALL  IDINFO  (FNAME,  Al) 
MARK(1)= 


^  Ik  Ik  Ik  *  Ik  4i  *  *  *  4i  Ik  *  Ik  41  Ik  *  Ik  4i  *  Ik  Ik  *  Ik  Ik  *  *  *  *  *  Ik  Ik  Ik  Ik  Ik  *  *  *  *  4t  Ik  Ik  *<  *  *  k  Ik  4>  <1  Ik  Ik  <1  Ik  k  *  k  4i  k  4i  *  Ik  Ik  Ik  Ik  k  *  *  *  Ik  *  Ik  Ik 

^kkkkkikk4i*«ikkkkkk  fJEW  INFORMATION  IS  OBTAINED  ************************** 

^kkkkk4<kkkkkkkkkikkkkkkkkkkkkkkkkkkikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


1160  CONTINUE 
CALL  CLEAR 

WRITE  (*,  *)  ’Creation  of  Master  File:  Main  Menu’ 

WRITE  (*.  6050)  MARK  (1).  MARK  (2),  MARK  (3),  MARK  (4) 

6050  FORMAT(15Xy///,’ 

1  y.lOX.’l.  Identification  information  ’,A1 

2  y,10X,’2.  Propellant  information  ’,A1 

3  y,10X,’3.  Igniter  information  ’,A1 

4  y,10X,’4.  Write  the  master  file  ’,A1 

5  y,10X,’5.  Exit  'JO 

WRITE  (*,  *)  ’  ’ 

WRITE  (*.  6060) 

6060  FORMAT(10X,’An  *  indicates  that  the  information’^ 

l.lOX.’has  been  provided.’,/,10X,’Please  Enter  Your  Choice  (1-5):’) 

READ  (*,  *)  ISELEC 
IF  (ISELEC  .EQ.  10)  THEN 
CALL  PRINTP  (Al) 

Qkkiikkkkkkkkkikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


C*************  UNDOCUMENTED  FEATURE  TO  PRINT  ARRAY  P  ******************* 

^kkkkkkk*4ikkkkk4ikk4ikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


GOTO  1160 
END  IF 

IF  aSELEC  .GT.  5)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  5.’ 
PAUSE 
GOTO  1160 
END  IF 


^k4i4ikkikk4i4i4i4i*4iik4>4ikkkkk4ikk4ikk*4i4i*4i4i4i4ikkkkkkkkkkkkkkk4ikkkkkkkkkkkkkkkkkkkk 
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Q*«4ii|i*i)til[4>iti4t4<4n|ii«>it»ti4i4i4i*4i4i  £]sn)II^(j  THE  PROGRAM 

^  *  4<  *  Dxli  *  *  *  *4)  Hi  *  *  *  *  *  *  Ht  *  4iit<  *  4i  4>  %  *  «  *  *  *  <1  *  4>  *  *  *  *  4ii|i  *  «  Hiiti  Ik  «  41  «>  41  *  O  4>  *  «  *  *  *  *  *«  *  *  4> «  *  <t<  *  i«i «  * 

IF  aSELEC  .EQ.  5)  GO  TO  1170 

Q  Ik  Ik  4<  4i  4i  4<  4<  4<  41 41 4<  4i  4>  4>  4i  4>  41 4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  <k  4i  4>  4i  41  *  4i  41 4<  4i  4<  41 4i  41 4i  4>  4i  4i  4i  4<  4i  4i  4i  4i  4i  4<  4<  4<  4i  4i  4>  4>  4>  4<  4<  4<  4<  4<  4i  4i  4i  4i  4i  4i 

C***********  THE  IDENTinCATION  INFORMATION  IS  OBTAINED  4.4.4.**ik4.4i4i4i4i4i4.4.4.4. 

^4i4i4i4<4i4i4<4i4>4i4<4>4><<4<4<4<4<4>4<4<4i4i4<4ii  4i4i4i4i4i4i4i4i4i4<4>4i4i4i4i4i4<4<4i4>4i4i4i4>4i4i4<4i4i4i4<4i4<4<4i4<4i4>4iik4i4i4i4i4i 

IF  aSELEC  .EQ.  1)  THEN 
CALL  IDINFO  (FNAME,  Al) 

MARK  (1)  = 

GOTO  1160 
END  IF 

^4i4iik4i4<4<4<4i4i4<4>4i4i4<4i4<4’4i4i4i4i4i4i4i4i4i4i4>4<4i4'4i4i4i4<4i4i4i4i4i4i4i4i4i4i4<4>4<4i4<4>4i4i4i4i4i4i4i4i4<ik4i4i4<4>4<4i4>4i4>4i 

C  THE  PROPELLANT  INFORMATION  IS  OBTAINED 

Q  «  4>  41 4i  41 41 41 4i  41 4>  4>  41 4<  4>  4i  41 4<  4i  4i  4i  4i  4i  4i  41 4i  41 4i  4<  4<  4i  41 41 4<  4i  41 4i  4i  4i  4i  4i  4>  4i  4: 41 4>  41 4i  4>  Ik  4<  41 41 4i  4<  4i  4i  4i  4>  4i  4i  41 4>  4<  Ik  4<  4>  4<  4<  4>  4>  4> 


IF  aSELEC  .EQ.  2)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’Creation  of  Master  File:  Propellant  Information’ 
WRITE  (*,  6070) 

6070  FORMAT(////,10X,’BRLCB  treats  all  propellants  as  deterred.’,/, 
llOX.’To  describe  a  deterred  grain  up  to  15  distinct  regions’,/, 
210X,’may  be  specified.  For  each  region  all  properties  are’y, 

31  OX, ’specified  at  the  beginning  and  end  of  the  region.’,/, 

41  OX, ’Intermediate  values  are  obtained  by  linear  interpolation.’/, 
510X,’To  describe  layered  grains  the  properties  at  the  beginning’, 
6/,10X,’and  end  of  a  region  are  the  same.  A  homogeneous  grain’y, 
71  OX, ’is  a  layered  grain  with  one  region. ’y/) 

PAUSE 
CALL  CLEAR 
WRITE  (*,  6080) 

716  FORMAT(///,10X,’lf  the  .MAS  file  is  being  built  from  an  existing 
ry,10X,’.MAS  file,  it  is  assumed  that  cither  the  propeUani’,/, 

21  OX, ’geometry  or  thermochemistry  is  the  same  as  in  the  .MAS’y, 
310X,’from  which  the  current  file  is  being  created.  If  this  is’, 
4/,10X,’the  case,  then  the  appropriate  options  on  the  Propellant’ 
5y,10X,’Information  Sub-menu  do  not  have  to  be  run.’y^ 

PAUSE 

CALL  PROPEL  (Al) 

MARK  (2)  =  ’*’ 

GO  TO  1160 
END  IF 


^  4i  4i  Ik  4i  4<  4i  4i  4<  4i  41 4<  4<  Ik  4<  4i  4<  4<  4>  4<  4<  Ik  4<  4i  Ik  Ik  4i  4i  41 41 4<  41  Ik  4<  Ik  4>  41 4>  41 41 41  Ik  4<  4i  Ik  41 4i  4>  4i  4i  4<  4<  4i  4i  4i  4>  4<  4i  4>  Ik  4>  <k  41 4i  k  41 4i  Ik  4<  Ik  Ik  4i 
^4i4i4i4>4i4rik4<4i4<ikik<kikik  IGNITER  INFORMATION  IS  OBTAINED  4i4.4.4i4i4.4.ikik4.4.4>4i4i4i4.ik4<4i4.4.4cik 
Q  4i  4<  4<  4i  4>  4i  4<  4i  Ik  4i  4iik  4iik  Ik  Ik  Ik  Ik  Ik  Ik  4>  4<  Ik  41  Ik  Ik  41 41 4i  4i  4i  4i  4<  4<  4i  4i  4>  4i  4i  Ik  4>  Ik  4<  Ik  >k  Ik  Ik  4i  Ik  4»k  Ik  Ik  >k  41 4i  4i  4i  4<  Ik  4<  Ik  4i  4i  4<  41 4<  Ik  4<  Ik  Ik 


IF  (ISELEC  .EQ.  3)  THEN 
CALL  IGNTT  (Al) 
MARK  (3)  =  ’*’ 

GOTO  1160 
END  IF 
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Q  *41  *  *  itciti  41 «  *  «  «■  4>  *  *  *  *  *  *<  *  *  <ti  4>  III  *  *  Hi  <1 4i  Hi  ti  *  *  «>  4i  4i  4i  *  *  %  *  4<  *  4>  *  4<  *  *  Kiili*  1)1  *  «  «  4i «  4i  *  *  *  *  *  * 

C************  THE  MASTER  INFORMATION  FILE  IS  CREATED  ******************* 

Q4>4>4i4i4i4i**4i4i4<4i4>*4ii*'4i4>4<****4>4i4i4>*4>4i4i4<4i4>*4i4<4>4<4i4i4i4<*4i4<4i4i4<4'4>4i4>4>4>*4>4i4i4i4i4i4>4i4'4<4i4<**4i 

IF  OSELEC  .EQ.  4)  THEN 

^  4>  4i  4i  4i  4i  4>  4<  4<  41 4c  4i  *  *  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4>  *  *  4i  4i  4<  4’ 4<  4>  4i  4i  4i  4>  4i  *  *  *  4t  4>  4i  4i  4<  4>  4>  4i  4i  4i  4i  4i  4i  4i  4<  4<  4' 4>  4<  *  *  *  4i  4>  4i  4i  4i  4i  4>  4>  4i 

C************  DEPTHS  OF  THE  LAYERS  ARE  DETERMINED  o********************* 

Q  4c  4c  *  4t  4c  4i  4c  *  4i  4i  4i  *  4i  4i  4i  4t  4i  4c «  4c  4<  4c  4c  4c  *  *  4i  4i  4c  4c  4c  4c  4i  4t  4i  4c  4i  *  4i  4i  4i  4c  4i  4c  4>  4i  4c  4>  4c  4c  4i  4<  4i  4c  4c  4c  4c  4c  4i  4i  4>  4c  4i  4i  4i  *  4c  4c  4c  4c  4c 

NUMPTS  =  DMT  (A3  (4)  +  .5) 

IF  (NUMPTS  .EQ.  1)  THEN 
P(l.  1.2)  =  A3  (I) 

ELSE 

P  (1.  NUMPTS,  2)  =  A3  (1)  -  P  (1,  NUMPTS,  1) 

DO  11801=  1,  NUMPTS  -  1 
P(l.  J,  2)  =  P(1,J+  1.  1)-P(1.  J.  1) 

1180  CONTINUE 
END  IF 
CALL  CLEAR 
1190  CONTINUE 

OPEN  (UNIT  =  7.  FILE  =  FNAME,  ERR  =  1200) 

GO  TO  1210 
1200  CONTINUE 
WRITE  (*,  6090) 

6090  FORMAT(10X,’An  Error  has  occurred  on  opening  the  master  file.  V, 

1  lOX.’Most  likely  the  file  already  exists.  Your  options  are;  V, 

2  15x,’l.  Overwrite  existing  file.V, 

3  15x,’2.  Enter  new  name.VA 

4  15x, ’Enter  your  choice.’) 

READ  (*,  *)  MCHOICE 
IF  (MCHOICE  .EQ.  1)  THEN 

OPEN  (UNIT  =  7,  HLE  =  FNAME,  STATUS  =  ’OLD’,  ERR  =  1200) 

GO  TO  1210 
ELSE 

WRITE  (*,  6100) 

6100  FORMAT(10X, ’Enter  the  new  file  name,  include  drive'y, 

1  lOX.’and  extension.’) 

READ  (*.  5010)  FNAME 
A1  (3)  =  FNAME 
GOTO  1190 
END  IF 

1210  CONTINUE 
DO  1220  1=  1,6 
WRITE  (7,  6110)  A2  (I) 

6110  FORMAT(A80) 

1220  CONTINUE 

DO  1230  I  =  1,  20 
WRITE  (7,  6120)  A1  0) 

6120  FORMAT(A20) 

1230  CONTINUE 
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DO  12401=  1.  100 
WRITE  (7.  *)  A3  a) 

1240  CONTINUE 

DO  12501  =  1,  11 
DO  1260  J  =  1,  15 
DO  1270  K  =  1.  5 
WRITE  (7.  *)  P  (I,  J,  K) 

1270  CONTINUE 
1260  CONTINUE 
1250  CONTINUE 
MARK  (4)  =  •*’ 

CLOSE  (UNIT  =  7) 

CALL  CLEAR 
WRITE  (*.  6130)  A1  (3) 

6130  f:OR}i/lfii,’r(////^lQX,'********************************‘**************\ 

l/.iox.**  ’  ’  **. 

2/,10X,’*  The  Master  File  Has  Been  Written  *’ 

3/.10X,’*  The  name  is:  •.A20.’ 

4  A 1  OX  ) 

WRITE  (*.  6140) 

6140  FORMAT(/////) 

PAUSE 
GOTO  1160 
END  IF 

^<tc*it<*4iit<*4>iii*4>4<***4«ti*4t  EXIT  FROM  PROGRAM  ***<"*"*'4"*"t"*"*'*'*>*<*>i'**'*'*"*'*«<**'*"*"i"*'t"*'** 

^  4i  iX  «  «  *  Kt  I*  *  m  *  *  *  *  *  *  *  4>  *  «  «  *  *  *41 4i  4c  *  it<  *  Di  *  *  Kiiti  4>  *  «  *  *  *  «  *  *  *  *  *  «i  itiili  4i  *  4<  «»•>  <“•<  *  *  *  *  *  *  *  * 

1170  CONTINUE 
EXIT  =  1 
CALL  CLEAR 

VF  (MARK  (1)  .NE.  ’*’)  THEN 
WRITE  (*,  *) 

1  ’The  identification  information  has  not  been  entered.’ 

WRITE  (*,  *)  ’Proceed  with  exit  (1)  or  return  (2)?  ’ 

READ  (*.  *)  lEXIT 
ENDE 

E  (MARK  (2)  .NE.  ’*’)  THEN 

WRITE  (*,  *)  ’The  propellant  information  has  not  been  entered.’ 

WRITE  (*,  *)  ’PrcKccd  with  exit  (1)  or  return  (2)?  ’ 

READ  (*.  *)  lExrr 
ENDE 

E  (MARK  (3)  .NE.  ’*’)  THEN 
WRITE  (*,  *)  The  igniter  information  has  not  been  entered.’ 

WRITE  (*,  *)  ’Proceed  with  exit  (1)  or  return  (2)?  ’ 

READ  (*,  •)  EXIT 
ENDE 

E  (MARK  (4)  .NE.  ’•’)  THEN 
WRITE  (*,  *)  ’The  ma.ster  file  has  not  been  written.’ 
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WRITE  (*,  *)  ’Proceed  with  exit  (1)  or  return  (2)?  ’ 

READ  (*,  *)  EXIT 
END  IF 

IF  (EXIT  .NE.  1)  GO  TO  1 160 

STOP 

END 

Q  *  Di  *  4ci|<  He  *  m  «  4.  *  *  *  «  «  «  Hi  41 «  «  *  **  4ii»  «  «  «  *  *  *  *  *  41 Kiilt  mitt  *  «  *  *  *  *  He  IK  O  >•<  «  4c  *  4i  *  *  «  4c  4>  4' *  4»f  *  * 
Qm4i4i*4i4i4>4i4i>|i4i4i4i4i4i4i4i4i4i4imm*  SUBROUTINE  CLEAR 

^  4t  4i  4i  4i  4i  4i  4i  4i  4i  4t  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  *  m  4i  4i  4i  *  4i  4t  4i  4i  4>  *  4i  4i  4i  4i  m  4i  4i  4i  4<  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4c  m  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 

SUBROUTINE  CLEAR 
CHARACTER  ST*4 
DATA  ST/’  [2J’/ 

WRITE  (•.  6000)  ST 
6000  FORMAT  (1X.A4) 

RETURN 

END 

^  4i  4i  4c  4i  4i  4i  m  4c  4c  m  4i  4i  4c  4c  4c  4c  4c  4c  4c  4<  4<  4>  m  m  4i  4i  4c  14  4i  4c  4t  4c  4>  4t  *  4<  4c  4c  4i  4i  4i  4c  4i  4c  4i  4>  4t  4c  4t  4c  4c  4i  4i  4>  4i  4c  4c  4c  4<  4c  4c  4c  4c  4<  4<  4c  4c  4c  4i  4<  <l< 
Q4cifc4c4c4c4c4i4c4c4c4c4c4ic(c4c4c4c4cc44c4c4i  SUBROLTINE  IDINFO  4i44c4c4c4c44i4i4c4c4cc44i4c4c4c4i4c4c4c4c4c4c4c4c4i4t4c4c 
^  i4 14  4c  c4  4c  4c  4c  4c  4t  4i  4c  4i  4c  4i  4i  i4  4c  4c  4c  4c  4c  4c  4c  4t  4c  4i  4i  4i  4i  4i  4i  4c  4i  4c  4i  4>  4i  4i  4>  c4  4t  4c  4t  4>  4i  4c  4i  4i  4c  4>  4>  4  4>  4i  4>  4t  4c  4c  4i  4c  4c  4t  4<  4i  4c  4c  4c  4c  *  4<  4c 

SUBROUTINE  IDINFO  (FNAME,  At) 

CHARACTER*20  DRIVE.  TNAME,  FNAKE,  A.  A1  (20),  ZZl 

Q  4c  4i  c»  4c  4i  4c  4i  4c  4c  4i  4c  4i  4i  4i  4c  4i  4  4c »  4c  4c  4c  4c  4c  i4  4c  *  4i  4i  4>  *  4i  4i  14  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  i4 14  4i  4c  4c  4c  4>  4c  4c  4i  4c  4c  4t  4c  4c  4c  4i  4i  4c  4i  4c  4t  4i  4c  4c  4<  4c 


C  Version:  3.0,  January  1992 
C 

C  Written  by  :  William  Oberle,  Ballistic  Research  Laboratory 
C 

C  This  subroutine  will  ask  for  identification  information  and  determine 
C  the  file  name  under  which  the  information  is  to  be  stored. 

^44c4444444444444444c4444444444444444444444444444444444444444444c4444>44444 

CALL  CLEAR 
WRITE  (*,  6000) 

6(X)0  FORMAT(’  ’.’Creation  of  Master  File:  Idcntincaiion  Information’, 

MHHf) 

WRITE  (*.  6010) 

6010  FORMAl(’  ’.lOX.’Entcr  the  project  name:') 

READ  (*.  5000)  ZZl 
5000  FORMAT(A20) 

A1  (1)  =  ZZ1 
CALL  CLEAR 
WRITE  (*,  6000) 

WRITE  (*,  6020) 

6020  FORMAT(10X,’Enter  the  name  of  the  person  requesting  the  work:’) 

READ  (*,  5000)  ZZl 
A1  (2)  =  ZZl 
CALL  CLEAR 
WRITE  (*.  6000) 

1000  CONTINUE 
WRITE  (*,  6030) 
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6030  FORMAT(/,10X, ’Enter  the  name  for  the  Master  Information’, 
l/,10X,’File.  All  DOS  path  conventions  can  be  utilized.  It  is’, 

2/,10X,’suggested  that  the  extension  of  the  file  be  .MAS.’) 

READ  (*.  5010)  FNAME 
5010  FORMAT(A20) 

OPEN  (UNIT  =  12.  FILE  =  FNAME.  STATUS  =  ’NEW’,  ERR  =  1010) 

A1  (3)  =  FNAME 
CLOSE  (UNIT  =  12) 

GO  TO  1020 
1010  CONTINUE 
WRITE  (*.  6040) 

6040  FORMAT(l OX, ’WARNING:  The  indicated  ftlc  already  exists.’ 
l/,15x,’l.  Overwrite’y,15x.’2.  Enter  new  name.’/ 

215x,’Enter  your  choice.’) 

READ  (*.  *)  IH 
IF  GH  .EQ.  2)  THEN 
GO  TO  1000 
ELSE 

A1  (3)  =  FNAME 
END  IF 

1020  CONTINUE 
RETURN 
END 

^*4i**4i*****«««4>*4i*«  SUBROUTINE  IGNIT  ***<*'***'*'**'*4'*'****4'******>^**4'****'<^'*' 

^*4i******4i***«4r«****»*«4i*«i«i***«««***4>*4i*«4i*«i*«r*4i**»«>****4i4t4i*4i4i[»4i4i*i»4i«4i4i 

SUBROUTINE  IGNIT  (Al) 

COMMON  A3  (100),  P  (11.  15.  5) 

CHARACTER*20  MARK  (2)*I.  Al  (20).  A5  (10.  3), 

1  CTEMP,  CTEMP1*15.  ZZl 
DIMENSION  B  (10.  6) 

MARK  (1)  =  ’  ’ 

MARK  (2)  =  ’  ’ 

C  Version:  3.0,  January  1992 

C  Written  by:  William  Obcrlc,  Ballistic  Research  Laboratory 
C  an  extension  of  a  routine  written  by 

C  Kristot^r  Koehnen 

C  Applied  Combustion  Technology.  Inc. 

C 

C  The  purpose  of  this  program  is  to  determine  the  values  for  the 
C  thermochemistry  and  pertinent  data  for  the  igniter  used  in  the 
C  closed  chamber  firing. 

. . . . *********** 

1000  CONTINUE 
CALL  CLEAR 

. . . . ************************** 

(^********  determination  of  the  type  of  igniter  being  used  ************** 
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Q  4i  4I «  4i  *  *  4.  Killi  IN  «>  4>  4>  *  4i  4^  *  <<  4>  4>  *  #  4<  *  <«i  4i «  *  *  >t> « ><■  !)•  4' «>  <••  Iti  *  >«■  4<  It<  *  *  «  4<  *  4i  Ki  It>  *  4i  4I  <•<  4>  *  *  %  *  «  «  « 


WRITE  (•,  6000) 

6000  FORMATC  ’/Creation  of  Master  File:  Igniter  Information’,///) 
WRITE  (*.  6010) 

6010  FORMAT(10X,’Infonnation  concerning  the  type  of  igniter’, 
1/,10X, ’being  used  is  needed.  The  available  options  are:’//, 
215X,’  1.  Black  Powder  'J, 

315X,’  2.  Enter  New  Information’,/, 

415X,’  3.  Use  Igniter  Library  'J, 

515X.’  4.  Exil’y/) 

1010  CONTINUE 

WRITE  (*,  *)  ’Please  Enter  Your  Choice:  ’ 

READ  (*,  *)  IGC 
IF  aCC  .GT.  4)  THEN 

WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  4.’ 

GO  TO  1010 
END  IF 


^  «  4  *  *  *  *  *  4,4,  <1  *  *  *  *  *  *  *  4i  *  *  «  *  *  4i  4i  4<  4<  *  <1  *  *  *  <ti  IN  4i  4<  *  4i  *  *  *  4i  *  *  *  >N  4  4i  4"t> «  4i  *  1*1 4c  4<  IN  4> «  4<  *  4>  4>  4i  *  *  *  *  * 

(^4<iN4.4>4i4i4i4i*4i4i*iNiNiN  SELECTION  OF  OPTION  IS  MADE  *************************** 


^  4i  4i  4i  4i  4<  4|  *  4i  4i  4i  4i  4|  4>  4<  4i  4<  4<  N  *  IN  4i  *  4i  4i  4c  4i  4i  4<  4<  4i  4>  4>  IN  4t  4i  4>  4>  <N  4i  4>  4c  4i  4>  N  4>  4c  4>  4>  N  4i  4>  4<  4I N  4>  4<  4c  4c  4<  4<  4>  4<  4i  4<  4>  4i  4<  4i  4<  IN  4i 


GO  TO  (  1020,  1030,  1040,  1050)  IGC 

^4i4i4i4c4iN4iiN*iN4c4i4c4i4i4i4c4i4c4iN4i*4i4i4i4i4i4c4i4i4>4i4c4i4c4c4i4i4c4cN4i4iN4i4c4c4c4c4c4c4i4i4i4i4i4>4c4c4i4c4i4c4c4c4i4c4c4c4c 
^4c4i4i4c4cN4iN4c*iN4c4c4c4c4c4c4ciN  (JSfNG  BLACK  POWDER  4i4ciN4ciN4c4c4c4c4c4c4i4c4i4ciN4c4c4c4c4c4c4c4i4c4i4c4c4c4c4c4> 
^  4c  4i  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4c  4c  *  4c  4i  4i  4i  4i  4<  4i  4c  4i  4i  4i  4i  4c  4c  4c  4c  4i  4i  4c  4i  4i  4c  4i  4i  4c  4c  4c  4c  4i  4i  4i  4c  N  4i  4c  4c  4c  4c  4c  4c  4i  4c  4c  N  4c  4c  4i  4c  4c  4c  4c  4i  4i  4i  4i 

1020  CONTINUE 

A1  (11)  =  ’Black  Powder’ 

A1  (12)  =  ’FFFG  ’ 

A1  (13)  =  ‘PeUets,  Milan  Old.’ 

A3  (13)  =  290. 

A3  (14)  =  2188. 

A3  (15)=  1.75 
A3  (16)  =  66.37 
A3  (17)  =  .785 
A3  (18)  =  1.2184 

^  4c  4i  4c  cN  N  4c  cN  4c  4c  4c  4i  4c  4c  4c  4c  N  4i  4c  4i  4c  4c  4c  cN  4c  4c  4c  4c  N  4c  4i  4c  4c  IN  4c  IN  cN  4c  4c  4c  4c  N  4c  4c  N  4c  4c  4c  4c  N  4c  4c  4c  N  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 
^4c4c4c4c4c4c4ccN4ccN4c4c4c4iN4cN4c4c4c  £XITING  THE  ROUTINE  4c4cN4c4cN4c4c4c4c4c4c4c4cN4cN4c4c4c4c4c4c4c4c4c4c4c4c4c 


^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  N  4c  4c  N  4c  4i  IN  N  4c  4c  4c  4c  4c  4c  *  4c  4c  *  4c  N  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  N  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


1060  CONTINUE 
CALL  CLEAR 
WRITE  (•,  •)  ’ 
WRITE  (*,  *)  ’ 
WRITE  (*,  *)  ’ 
WRITE  (*.  *)  ’ 
WRITE  (*,  *)  ’ 
WRITE  (*.  *)  ’ 
WRITE  (*.  *)  ’ 
WRITE  (*,  •)  ’ 
WRITE  (*,  *)  ’ 


You  have  selected  black  powder  as  the  ’ 
type  igniter  which  is  being  used.  Your’ 
options  are:’ 


1.  Accept  Black  Powder  and  Exit’ 

2.  Review  Black  Powder  Information' 

3.  Enter  Different  Igniter  Information’ 
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1070  CONTINUE 


WRITE  (*,  *)  ’  Please  Enter  Your  Choice:  ’ 

READ  (*.  *)  lANSWER 
IF  aANSWER  .GT.  3)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  3.’ 
GO  TO  1070 
END  IF 

IF  GANSWER  .EQ.  1)  RETURN 
IF  GANSWER  .EQ.  3)  GO  TO  1000 


^  *  <1  Ik  *  i|<  4i  *  *  i|i  *  4<  *  *  4i  *  *<!■  *  *  *  *  *  Ik  *  4i « III*  4i  *  41 4c  4>  4i «  4i  *  4t  *  *  «  «  *  *  «  4t «  *  I#  *  4;  *  *  *  *  «<  *41  « i|>  *  *  *  *  *  * 

(2;4.4<4>ik4<4»k4<4>4>4<4>4<  BLACK  POWDER  REVIEWING  INFORMATION  ********************** 

^4c4<******>k**************4i*4<************4>******************************** 


CALL  CLEAR 
WRITE  (*,  *) 

WRITE  (*,  *)  ’  Information  for  black  powder.’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*.  6020) 

WRITE  (*.  6030) 

WRITE  (*,  6040) 

WRITE  (*.6050)  A1  (11) 

WRITE  (*.  6060)  A1  (12) 

WRITE  (*.  6070)  A1  (13) 

PAUSE 
CALL  (XEAR 
WRITE  (*,  6020) 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’This  is  the  thermochemical  data’ 

WRITE  (*.  *)  ’for  black  powder.’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  6020) 

WRITE  (*,  6030) 

WRITE  (*,  6040) 

WRITE  (*,  6080)  A3  (13) 

WRITE  (*,  6090)  A3  (14) 

WRITE  (*,  6100)  A3  (15) 

WRITE  (*,  6110)  A3  (16) 

WRITE  (*,  6120)  A3  (17) 

WRITE  (*.  6130)  A3  (18) 

WRITE  (*,  6020) 

WRITE  (*.  *)  ’  ’ 

PAUSE 
GO  TO  1060 

^4i***4>***********4i4i*4i4<4i4i4c4c******4<4<**4i4c*4i4i4’*4'4i*4i4'*******4>***4>***4i4i4r4i4c4i4i4i4i 


^4i4i4i*4i4i4i4iikik******4>****  ENTERING  NEW  DEFORMATION  ************************ 

^***********************4>*************’S<4c*******4c*  ******  4<4>4>*4<**4<4c*4<*4c**4i4i 


1030  CONTINUE 
CALL  CLEAR 


WRITE  (*,  *)  ’  ’ 
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WRITE  (*,  *)  ’There  are  two  sets  of  data  which  must  be’ 

’  VRITE  (*,  *)  ’entered  for  the  igniter.’ 

WRITE  (*,  '•')  ’An  *  indicates  that  the  information  has  entered.’ 

WRITE  (*.  *)  ’They  are:’ 

WRITE  (*,  6140)  MARK  (1) 

WRITE  (*,  6150)  MARK  (2) 

6140  FORMAT(’  1)  Identification  ’.Al) 

6150  FORMATC  2)  Thermochemical  ’.Al) 

WRITE  (*,  *)  ’  3)  Exit’ 

WRITE  (*.  *)  ’  ’ 

1080  CONTINUE 

WRITE  (*,  *)  ’Please  Enter  Your  Choice:  * 

READ  (*.  *)  ICHOICE 
IF  aCHOICE  .GT.  3)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  3.’ 

GO  TO  1080 
END  IF 
CALL  CLEAR 
IF  aCHOICE  .EQ.  3)  THEN 

WRITE  (*,  *)  ’Add  the  new  information  to  the  igniter  library?’ 

WRITE  (*,  *)  'Enter  1  to  add  to  library  else  a  2.  ’ 

READ  (*.  •)  IGADD 

IF  (IGADD  .EQ.  1)  CALL  IGNADD  (Al) 

GO  TO  1000 
END  IF 

C"""*****  The  program  will  branch  to  the  choice  that  was  made.  ********** 

i|<  4i  4<  *  *  4i  *  *  «  «  *  *  **  «  41 4i  *  «  4i «  *  *  4iitii|ii|i «  4i  4i  *  4.  it<  I*  *  4. 4i  4i «  III  4.  *  *  »  *  *  III  *  *  III  Hi  *  *  *  *  *  *  *  *  4>  4>  *  *  *  Ik  *  <1 

GO  TO  (  1090,  1100)  ICHOICE 

^  4i  4i  4i  4>  *  *  *  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4>  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i 

C*’"********  The  identification  data  is  read  in  interactively.  ********** 

^  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  41 4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4<  4i  41 4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i 

1090  CONTINUE 
CALL  CLEAR 
MARK  (1)  =  ’*’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  •)  ’For  each  question,  enter  the’ 

WRITE  (*,  *)  ’information  for  the  igniter.’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  6160) 

6160  FORMATC  ’.’Enter  Igniter  Name:’) 

READ  (*.  5000)  ZZl 
Al  (11)  =  ZZl 
WRITE  (*.  *)  ’  ’ 

WRITE  (*,  6170) 

6170  FORMATC  ’.’Enter  Igniter  Lot:  ’) 

READ  (•,  5000)  ZZl 
Al  (12)  =  ZZl 
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WRITE  (*.  *)  ’  ’ 

WRITE  (*,  6180) 

6180  FORMATC  ’.’Enter  Igniter  Source:’) 

READ  (*,  5000)  ZZl 
A1  (13)  =  ZZl 
CALL  CLEAR 
WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’ITiis  is  the  identification  information’, 
1  ’  that  you  have  entered.’ 

WRITE  (*.  6020) 

WRITE  (*,  6030) 

WRITE  (*.  6040) 

WRITE  (*,  6050)  A1  (11) 

WRITE  (♦,  6060)  A1  (12) 

WRITE  (*.  6070)  A1  (13) 

WRITE  (*,  6020) 

PAUSE 
GO  TO  1030 


^  1)1 4i  *  4i  *  *  *  Ik  4i  1)1  Hi «  4<  i|. «  41 «  *  «  «  *  «  «  4<  « 1)1 4, 1).  i|>  He  it>  III  4>  *  «  *  *  *  *  *  >«>  4>  *  *  <•<  4<  4< «  «  *  « III «  * 

C*********  The  thermochemical  data  is  entered  interactively.  *********** 

Q*t*^|^|*^i^i^i**^i:^,^i*itlt,^tt*^iltl^l00*^|^i*^i*:t**************************************** 


1100  CONTINUE 
CALL  CLEAR 
MARK  (2)  =  ’*’ 

WRITE  (*,  *)  ’For  each  question,  enter  the’ 

WRITE  (*,  *)  ’information  for  the  igniter.’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  •)  ’Theoretical  Impetus  (J/gram):  ’ 

READ  (*,  *)  A3  (13) 

WRITE  (*,  *)  ’Flame  Temperature  (K):  ’ 

READ  (*,  *)  A3  (14) 

WRITE  (*,  *)  ’Density  (gram/cc):  ’ 

READ  (*.  *)  A3  (15) 

A3  (16)  =  8.314*A3  (14)/A3  (13) 

WRITE  (*,  6190)  A3  (16) 

6190  FORMAT(/,’  ’,’The  molecular  weight  consistent  with  the  Flame’, 
1/,’  '.’Temperature  and  Impetus  is:’.F8.4, 

2/,’  1.  Accept  Value’,/,’  2.  Enter  different  value’) 

READ  (*.  •)  IMAYBE 
IF  (IMAYBE  .EQ.  2)  THEN 

WRITE  (♦,  *)  ’Enter  value  for  Average  Molecular  Weight:  ’ 
READ  (•,  •)  A3  (16) 

END  IF 


WRITE  (*.  *)  ’Co- Volume  (cc/gram):  ’ 

READ  (*.  *)  A3  (17) 

WRITE  (*,  *)  ’Ratio  of  Specific  Heats  (gamma):  ’ 
READ  (*.  ♦)  A3  (18) 

CALL  CLEAR 
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WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’This  is  the  thermochemical  data  you  have  entered.’ 

WRITE  (*,  6020) 

WRITE  (*,  6030) 

WRITE  (*,  6040) 

WRITE  (*.  6080)  A3  (13) 

WRITE  (*,  6090)  A3  (14) 

WRITE  (*,  6100)  A3  (15) 

WRITE  (*,6110)  A3  (16) 

WRITE  (*,  6120)  A3  (17) 

WRITE  (*.  6130)  A3  (18) 

WRITE  (*.  6020) 

WRITE  (*.  *)  ’  ’ 

PAUSE 
GO  TO  1030 

^  Iti  skill  *  Dcik  *  Id  *  «****««  *41*  4<  ■)<**  4<4«(<  O*  ********  O' «<*<<•  O*  **  4>  Xi  *  4«l>  Hi  *  4>  *  O*  O'*  4«l>  »<  * 

Q4>4i<didididid4<4i*>ti4i4>4i4>4i44<4<id4iid4i  FORMAT  STATEMENTS  ***************************** 

^  4i  4i  4i  4i  4i  *  *  4i  4i  4>  4i  4i  4i  4i  4<  4>  4i  4<  4i  4i  4i  4i  4i  Id  *  4i  *  4i  4i  4>  4>  4<  4<  4i  4<  4i  4i  *  Id  4i  4<  4>  4i  *  4i  4>  4<  4<  4>  4i  4<  4i  4i  4i  *  4i  4i  *  4i  4i  4i  4i  4i  4<  4<  4<  4>  4<  4c  4i  4i 


6030  FORMAT(38X.’Igniter’) 

6040  FORMAT(38X,’ - ’) 

6050  FORMAT(10X.’Type:’.23X.A20) 

6060  FORMAT(10X,’Lot:’,24X.A20) 

6070  FORMAT(10X,’Source:’.21X.A20) 

8000  FORMAT(10X.’Weight  (grams):’) 

8010  FORMATdOX.’Initial  Temp.  (K):’) 

8020  FORMAT(’  ’) 

6080  FORMAT(10X.’Theo.  Impetus  -  (J/gram):’.F15.5) 

6090  FORMAT(10X,’Hame  Temp. - (K);’,F15.5) 

6100  FORMATdOX,’ Density - (gram/cc):’.F15.5) 

6110  FORMATdOX.’Avg.  Mol.  WL - :’.F15.5) 

6120  FORMATdOX, ’Co-Volume  —  (cc/gram):’,F15.5) 

6130  FORMAT(10X,’Gamma - :’,F15.5) 

8030  FORMAT(’  ’) 

5000  FORMAT(A20) 

6020  FORMAT(80(’-’)) 


^  4>  4>  Id  4c  4>  4>  4i  4i  <d  4>  4i  4i  4>  4i  Id  4<  4<  4>  4<  4>  4i  4>  4i  41 4<  4>  4i  4i  4c  4>  4c  4>  4>  4c  4c  4i  4>  4>  4i  4c  4<  4<  4c  4i  4c  4i  Id  4>  4c  4c  4>  4i  4>  4c  4c  ^c  4c  4<  4c  4<  4c  4i  4<  Id  4i  4i  4i  Id  4>  4< 


Q4c4c4c4c4c4c4i4c4iid4i4c4c4c4c4c4c  USING  THE  IGNITER  LIBRARY  4i4c4c4c4i4c4c4iid4c4i4c4i4i4'id4i4c4i4i4i4c4c4c4iid4c 

^  4i  4c  Id  Id  Id  4c  4c  4c  4i  4i  4i  4i  4c  4c  4c  4c  4c  4c  4i  4i  4i  Id  *  4c  4c  4c  4c  4c  4c  4>  4c  Xc  4c  4c  4i  4i  4i  4c  4i  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  Id  4i  4c  4i  4c  4c  Id  Id  4c  4c  4c  4c  4c  Id  Id  4c  Id  4i  4i  4c  4i  4c 


1040  CONTINUE 
CALL  CLEAR 

OPEN  (UNIT  =  3,  FILE  =  ’IGNTTER.INF’) 

READ  (3,  *)  NUM 

WRITE  (*,  *)  ’  Igniter  Library’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  6200) 

479  FORMAT(’  ’,’  #  Type  Impetus  Flame  Temp  Density  Mol 
IWt  Covolume  Gamma’) 

WRITE  (*,  6210) 
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DO  1110  I  =  l.NUM 
READ  (3.  5000)  A5  G,  D 
CTEMP  =  A5  a.  1) 

CTEMPl  =  CTEMP  (1:15) 

READ  (3.  5000)  A5  0.  2) 

READ  (3.  5000)  A5  0.  3) 

READ  (3.  *)  (B  G.  J).  J  =  1.  6) 

WRITE  (*.  6220)  I,  CTEMPl,  (B  (1.  J).  J  =  1.  6) 

6220  FORMATC  M2.1X.A15,6F9.3) 

1110  CONTINUE 
CLOSE  GJNTT  =  3) 

6210  FORMAT(75(’-’)) 

1120  CONTINUE 
WRITE  (*.  *)  ’  * 

WRITE  (♦,  *)  ’Enter  the  number  of  the  igniter  you  want  to  use.’ 
WRITE  (*,  *)  ’To  delete  an  entry,  enter  11.’ 

READ  (*,  *)  IGNUM 
IF  GGNUM  .GT.  11)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  11.’ 

GOTO  1120 
END  IF 


^  «■  «**«**  in  *  4i4i«*  Hi*  4iit<  DC*  iK  **  4>  **  4<  4<  ««*  ******  **  He  41  *****««***  Umi  Kent  %  iK  «]« %  <1 « 


C*********  Any  data  from  the  igniter  library  will  be  deleted.  ********** 
^*********************************************************************** 
IF  GGNUM  .EQ.  11)  THEN 
WRITE  (*,  *)  ’Enter  number  to  delete.’ 

READ  (*,  •)  IDEL 

OPEN  (3,  FILE  =  ’IGNrTER.INF’) 

WRITE  (3,  *)  NUM  -  1 
DO  1130 ,1=1,  NUM 
IF  (I  .EQ.  IDEL)  GO  TO  1 130 
WRITE  (3,  5000)  A5  (1.  1) 

WRITE  (3,  5000)  A5  (1.  2) 

WRITE  (3,  5000)  A5  G.  3) 

WRITE  (3,  *)  (B  G.  J).  J  =  1.  6) 

1130  CONTINUE 

CLOSE  GJNIT  =  3) 

GO  TO  1000 
END  IF 

A1  (11)  =  A5  GGNUM,  1) 

A1  (12)  =  A5  GGNUM,  2) 

A1  (13)  =  A5  GGNUM,  3) 

A3  (13)  =  B  GGNUM,  1) 

A3  (14)  =  B  GGNUM,  2) 

A3  (15)  =  B  (IGNUM,  3) 

A3  (16)  =  B  GGNUM,  4) 

A3  (17)  =  B  (IGNUM,  5) 

A3  (18)  =  B  GGNUM,  6) 
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GO  TO  1000 
1050  CONTINUE 
RETURN 
END 

^  *  4i  *  *  4ii|i  *  *  4i«iK  » *  4i «  4>  *  *  Hi  4,  Dc  «  4. «  «  4i  4i  4i  «  «  4, 4, 4,  «  4, 4, 4, 4, 4i  4, 4, 4, 4, 4, 4, 4,  ^  4, 4, 4, 4, 4, 4, 4, 4, ^  4, 4, 4, 

^4>4<4<4<4<4<4i4i4i4i4<4<4<4<4<4<4<4i4>4i4i4<4i4>4<  SUBROUTINE  IGNADD  ************‘l‘********t<*4>**4. 
^  4c  4>  4<  4>  4>  4<  4<  *  *  4i  4<  4>  4>  4<  4<  4<  4<  4<  4<  4>  4i  4i  4i  4i  4<  4>  4<  4<  *  *  *  4<  4>  4>  4<  4' 4<  4>  4r  *  *  «  4c  4r  4<  4<  4<  4<  4<  *  *  4<  4<  4<  4<  4<  4<  4>  4<  *  4<  4<  4i  4r  4<  4>  4' 4' 4<  4>  4< 

SUBROUTINE  IGNADD  (Al) 

COMMON  A3  (100),  P  (11.  15,  5) 

CHARACTER*20  Al  (20),  A5  (10.  3) 

DIMENSION  B  (10.  6) 

CALL  CLEAR 

OPEN  (UNIT  =  3.  FILE  =  TGNTTER.INF’) 

READ  (3.  •)  NUM 
IF  (NUM  .EQ.  10)  THEN 
WRITE  (*,  *)  ’The  igniter  library  is  fiill,’ 

WRITE  (*,  ♦)  ’delete  an  entry.’ 

CLOSE  (UNIT  =  3) 

RETURN 
END  IF 

DO  1000  I  =  1.  NUM 
READ  (3.  5000)  A5  0.  D 
READ  (3,  5000)  A5  H.  2) 

READ  (3.  5000)  A5  (I,  3) 

5000  FORMAT(A20) 

READ  (3,  •)  (B  a.  J).  J  =  1.  6) 

1000  CONTINUE 
CLOSE  (UNIT  =  3) 

NUM  =  NUM  +  1 
A5  (NUM.  1)  =  Al  (11) 

A5  (NUM,  2)  =  Al  (12) 

A5  (NUM,  3)  =  Al  (13) 

B  (NUM,  1)  =  A3  (13) 

B  (NUM,  2)  =  A3  (14) 

B  (NUM.  3)  =  A3  (15) 

B  (NUM.  4)  =  A3  (16) 

B  (NUM,  5)  =  A3  (17) 

B  (NUM.  6)  =  A3  (18) 

OPEN  (UNIT  =  3,  FILE  =  ’IGNTTER.INF’) 

WTUTE  (3.  •)  NUM 
DO  1010  I  =  1.  NUM 
WRITE  (3,  5000)  A5  G.  D 
WRITE  (3.  5000)  A5  G,  2) 

WRITE  (3.  5000)  A5  (I,  3) 

WRITE  (3.  •)  (B  (I.  J),  J  =  1.  6) 

1010  CONTINUE 
CLOSE  (UNIT  =  3) 

RETURN 
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END 

^  1)1 41 4i4i4t  4t  4i4i  4c  ****  Ik  *  itr  «4i  4i  itcili  41 itiiti  4' >)<  41 4<  4>  **  **<•<****>»  «i  *  t'*  i|>  >t<4<  Ik  **  4>  ***<•>*  it<  ■kit' 4>  *>•<  >t<  4i  * 

Q4c4'4i4>4c4c4i4>*4>4c4c4c4c4c4c4c4c4i4i4i4c4c4c*  SUBROUTINE  PROPEL  *************************** 
Qi^m********************************************************************* 


SUBROUTINE  PROPEL  (Al) 

COMMON  A3  (100),  P  (11.  15,  5) 

CHARACTER*20  Al  (20),  SMARK  (3)*1.  GTYPE*14 


^4i4i4i*4i4c4iik4i*4i4>iic4>4i4c4>4c4>4>4<4i4c4i4<4c4i***4i4ik4i4c4i4i4c4>4>4i4c4i4i4i4c4i4>4c4i4<4<4>4<4>4i4<4c4<4i4i4i4i4<4i4i4<4>4i4c 


C  Version;  3.0,  January  1992 


C 

C  This  program  requests  infonnation  concerning  the  propellant 
C  and  its  geometry.  The  grain  geometry  is  checked  for  consistency 
C  and  changes  are  computed  if  the  information  is  not  accurate. 


^4i4<4<4c4c4c4c4c4i4i4c4i4c4i4i**4i4i4i4c4<4c4c4<4c4c4>4>4c4c4c4c4>ik4c4c4>4c4>4c4c4>4>4c4c4c4>4c4c4c4c4c4c4c4c4c4i4>4'4<4>4c4c4c4c4c4c4i 


SMARK  (1)  =  ” 

SMARK  (2)  =  ” 

SMARK  (3)  =  ” 

1000  CONTINUE 
CALL  CLEAR 
WRITE  (*,  6000) 

6000  FORMAT(///.10X.’  PropeUant  Infonnation V. 

IIOX,*  Sub  Menu  V. 

210X,’Three  sets  of  ittformation  must  be  enteredV. 

310X,’for  the  propellant. V/, 

410X,’An  *  indicates  that  the  infonnation  has  been  entered.  V/) 

WRITE  (*,  6010)  SMARK  (1) 

WRITE  (*.  6020)  SMARK  (2) 

WRITE  (*,  6030)  SMARK  (3) 

6010  FORMATdOX,’  1)  Identification ’.A  1) 

6020  FORMAT(10X,’  2)  Thermochemical  ’.Al) 

6030  FORMAT(10X.’  3)  Geometry 

llOX,’  4)  Exit’ y/. 

210X,’Please  Enter  Your  Choice  (1-4):  ’) 

READ  (*.  *)  ICHOICE 
IF  aCHOICE  .GT.  4)  THEN 
WRITE  (*.  6040) 

6040  FORMAT(////.’YOUR  CHOICE  IS  NOT  BETWEEN  1  AND  4.’) 

GO  TO  1000 
END  IF 

^  4i4i  4i  4i  41 41 4i  4<  *  *  <1  *  *  i»  *  I#  *  4i  Hi  *  ■)■  *  *  41  DcDi  4i  *  41 4c  4>  41 4i  *  *  *  4i  4c  *  4i  4>  4i  4>  4i  41 41 4i  it>  4>  4<  4i  4i  41 4c  4c  4c  4c  4<  *  *  *  4c  4c  *  *  *  4c  4>  41 4c 
^*4c*4c4c4c4c4c4c4c4c4c4c4c4c4c4i4c4c  CHECKING  TO  RETURN***********"""******************** 
^4c*4c  4i*4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  ck  4c  c»4i  <4  4c  Ik  4i  Ik  4i4i  4c  4c  4c  4c  41 4c  4c  4c  4c  4c  4c*4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c*4c 


IF  aCHOICE  .EQ.  4)  THEN 
CALL  MAXDEPTH 
CALL  COMMASS 
RETURN 
END  IF 

^4c4iik4i4c*4c**4c4c*4c4c4c4c4cik4c4c4c4c4c4c*ik4c4cikik4i4c4c4c4cck4cik4cik4c*4c4c4c*4c4c4c4c4c4c4c4c4c4c4c4i4c**4c4cikikik4c4c*4i4c 
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C********  The  program  will  branch  to  the  choice  that  was  made  ******'*'*** 

^  <1  <1  *  III  <1  *  *  *  *  *  *  III  *  4i  i|>  4i «  4iitc  4i  4i  *  «  4i  *  *  « i|<  *  4> «  «  4>  4i «  4ii|i  *  4i  ]|i  III  i|<  4i  *  4<  *  41  <■  *  *  *  A  *  *  «  4i  it>  4>  «  4>  <1 

GO  TO  (  1010.  1020,  1030)  ICHOICE 

Q4i  *  41  i|i  41 41 41 41 41 4i  41 «  %  41 «  4i  III  III  4i  41  Hi  III  41 41 41  III  41 41  i|ii|i  4i  41  *  41  Ik  41  III  III  Ik  *  *  «  41 41  *  41 41 41  Ik  III  41 41 41  *  41  i|i  i|i  *  *  *  41  *  41 4i  III  41  *  III  III  *  41 


C*********  The  identification  data  is  read  in  interactively.  *********** 

^4i***4i******4i****************4i****************************************** 


1010  CONTINUE 
SMARK  (1)  = 

CALL  CLEAR 
WRITE  (*,  6050) 

720  FORMAT(10X,’For  each  question,  enter  the  information  for  the  prop 
lellanLV/) 

WRITE  (*.  6060) 

6060  FORMAT(10X.’PropeUant  Type:  ’) 

READ  (•.  5000)  A1  (6) 

WRITE  (*,  6070) 

6070  FORMAT(/,10X.’Propellant  Lot:  ’) 

READ  (*,  5000)  A1  (7) 

WRITE  (*,  6080) 

6080  FORMAT(/.10X,’PropeUant  Source:  ’) 

READ  (*.  5000)  A1  (8) 

CALL  CLEAR 
WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’This  is  the  identification  information  entered.’ 

WRITE  (*,  6090) 

WRITE  (*.  6100) 

WRITE  (*.6110) 

WRITE  (*,  6120)  A1  (6) 

WRITE  (*,  6130)  A1  (7) 

WRITE  (*,  6140)  A1  (8) 

WRITE  (*.  6090) 

WRITE  (*.  6150) 

6150  FORMATC////) 

PAUSE 
GO  TO  1000 

^4i********4i************4i************************************************ 

^4i4i****************  Thermochemical  data  is  entered  ********************* 


^4i***********************************************4i********************** 


1020  CONTINUE 
SMARK  (2)  =  ’*’ 
CALL  CLEAR 
CALL  LAYDET 
GO  TO  1000 


^Ikik*4i4i4i4i4i*************************************************************** 


C***********  The  geometry  is  inputted  interactively. 

4i  41*4144141***41********* 


^**********************************************44*********************** 

1030  CONTINUE 
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SMARK  (3)  = 

CALL  CLEAR 
WRITE  (■*■,  6160) 

6160  FORMAT(////) 

WRITE  (*,  *)  ’  1)  Sphere’ 

WRITE  (*,  *)  ’  2)  Coni’ 

WRITE  (*,  *)  ’  3)  Rectangular  Strip’ 

WRITE  (•.  *)  ’  4)  1 -Perforated  Cylinder’ 

WRITE  (*.  *)  ’  5)  Slotted  Tube’ 

WRITE  (*.  *)  ’  6)  7-Perforation  Cylinder’ 

WRITE  (*,*)’  7)  7-Perforation  Hexagonal’ 

WRITE  (*.  *)  ’  8)  19-Penoration  Cylinder’ 

WRITE  (*.  *)  ’  9)  19-Perforation  Hexagonal’ 

WRITE  (*.  *)  ’10)  37~Perforation  Hexagonal’ 

WRITE  (*.  *)  ’ll)  Cord  With  Inhibited  Ends’ 

WRITE  (*,  *)  ’12)  Sandwich  With  Inhibited  Sides’ 

WRITE  (*.  *)  ’13)  Cigarette’ 

WRITE  (•.  •)  ’  ’ 

WRITE  (*.  *)  ’Enter  the  number  corresponding  to  the  ’ 

WRITE  (*,  *)  ’grain  type  for  the  propellant:  ’ 

READ  (*.  *)  IGTP 
A1  (9)  =  GTVPE  (IGTP) 

A3  (45)  =  IGTP 
CALL  CLEAR 
WRITE  (*.  6160) 

WRITE  (*,  •)  ’For  each  question,  enter  the  information’ 

WRITE  (*,  *)  'for  the  propellant  grain  geometry,  all  ’ 

WRITE  (*,  *)  ’dimensions  in  cm.’ 

WRITE  (*,  *) 

PAUSE 

CALL  GRAIN  (IGTP) 

CALL  CKGRAIN  (IGTP) 

CALL  CLEAR 
WRITE  (*,  6170) 

6170  FORMAT(/////) 

WRITE  (*,  *)  ’This  is  the  grain  geometry  that  you  have  entered.’ 
WRITE  (*,  6090) 

WRITE  (*,  6100) 

WRITE  (*,6110) 

WRITE  (*.  6180)  A1  (9) 

IF  OGTP  .EQ.  1)  THEN 
WRITE  (*,  6190)  A3  (8) 

GO  TO  1040 
END  IF 

IF  ((IGTP  .EQ.  2)  .OR.  (IGTP  .EQ.  11)  .OR.  (IGIP  .EQ.  13))  THEN 
WRITE  (*.  6200)  A3  (7) 

WRITE  (*.  6190)  A3  (8) 

GO  TO  1040 
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END  IF 

IF  (aCTP  .EQ.  3)  .OR.  aOTP  .EQ.  12))  THEN 
WRITE  (*.  6200)  A3  (7) 

WRITE  (*,  6210)  A3  (8) 

6210  FORMAT(10X.’Width  (cfn.):’.F21.5) 
WRITE  (*,  6220)  A3  (10) 

6220  FORMAT(10X.’Thickness  (cm.):*F71.5) 
GO  TO  1040 
END  IF 

IF  ((IGTP  .EQ.  4)  .OR.  GOTP  .EQ.  5))  THEN 
WRITE  (*.  6200)  A3  (7) 

WRITE  (•,  6190)  A3  (8) 

WRITE  (*.  6230)  A3  (9) 

IF  (IGTP  .EQ.  4)  THEN 
WRITE  (*,  6240)  A3  (10) 

6240  FORMAT(10X/Web  (cm.);*, 121. 5) 

END  IF 

IF  (IGTP  .EQ.  5)  THEN 
WRITE  (*.  6250)  A3  (11) 

6250  FORMAT(10X.’Slot  Width  (cm.):’,F21.5) 
END  IF 
GO  TO  1040 
END  IF 

IF  ((IGTP  .EQ.  6)  .OR.  (IGTP  .EQ.  7))  THEN 
WRITE  (*,  6200)  A3  (7) 

WRITE  (*.  6190)  A3  (8) 

WRITE  (*.  6230)  A3  (9) 

WRITE  (*.  6260)  A3  (10) 

WRITE  (♦,  6270)  A3  (12) 

GO  TO  1040 
END  IF 

IF  ((IGTP  .GE.  8)  .AND.  (IGTP  .LE.  10))  THEN 
WRITE  (*.  6200)  A3  (7) 

WRITE  (*.  6190)  A3  (8) 

WRITE  (*,  6230)  A3  (9) 

WRITE  (*,  6260)  A3  (10) 

WRITE  (•,  6280)  A3  (11) 

WRITE  (*,  6270)  A3  (12) 

GO  TO  1040 
END  IF 

1040  CONTINUE 
WRITE  (*,  6090) 

WRITE  (*.  *)  •  ’ 

PAUSE 
GO  TO  1000 

8000  FORMATdOX.’Propcllant  Type:  ’AIS) 

6100  FORMAT(38X/PropcUanl’) 

6110  FORMAT(38X.’-- . ’) 
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6120  FORMAT(10X.Type:’.23X.A19) 

6130  FORMAT(10X.’Lot:’.24X.A19) 

6140  FORMAT(10X.’Source:’21X.A19) 

8010  FORMAT(10X, ’Weight  (grams):’) 

8020  FORMAT(10X,’IniUaI  Temp.  (K):’) 

8030  FORMAT(’  ’) 

8040  FORMAT(10X.’Theo.  Impetus  -  (J/gram):’.F15.5) 

8050  FORMAT(10X.’Hame  Temp. - (K):’.F15.5) 

8060  FORMAT(10X.’Density - (gram/cc):’.F15.5) 

8070  FORMAT(10X,’Avg.  Mol.  Wt. - :’jrl5.5) 

8080  FORMAT(10X,’Co-Voiume  —  (cc/gram):’JF15.5) 

8090  FORMAT(10X,’Gamma - r’J'lS.S) 

8100  FORMAT(’  ’) 

6180  FORMAT(10X, ’Grain  Type:’.16X.A14) 

6200  FORMAT(10X,’Length  —  (cm.):’J=21.5) 

6190  FORMATdOX.’Outer  Dia.  (cm.):’.F21.5) 

6230  FORMAT(10X.’Perf.  Dia.  (cm.);’.F21.5) 

6260  FORMAT(10X.’Inner  Web  (cm.):’.F21.5) 

6280  FORMAT(10X.’Middle  Web  (cm.):’.F21.5) 

6270  FORMAT(10X.’Outcr  Web  (cm.):’.F21.5) 

5000  FORMAT(A20) 

6090  FORMAT(80(’-’)) 

RETURN 

END 

^  «  *  »  »  *  4i  *  *  4i  4<  4>  *  4<  *  4>  #  4' 4<  4>  *  ^  4<  4«t>  Ik  <<  4>  !(•  ■!»•>  4«t>  *  *  *  4>  *  A  Ik  41  4>  4<  >t>  *  4>  *  *  *t  >!■ 

€"■****•****  This  function  will  detennine  the  grain  type.  4i4.4i4i4.4i4i4.4i4i4.4r4.4>4i 

Q  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  *  *  4i  *  4i  *  4i  4i  4i  4i  4i  4i  4i  4<  4>  4i  4i  4i  4i  k  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4>  4i  4i  4  *  4- *  4i  4i  4i  4i  *  4i 

FUNCTION  GTYPE  (I) 

CHARACTER  GTYPE*  14 
IF  (I  .EQ.  1)  GTYPE  =  ’Sphere’ 

IF  (I  .EQ.  2)  GTYPE  =  ’Cowl’ 

IF  a  EQ.  3)  GTYPE  =  ’Strip’ 

IF  (I  .EQ.  4)  GTYPE  =  ’l-Pcrf.  Cyl.’ 

IF  (I  .EQ.  5)  GTYPE  =  ’Slotted  Tube’ 

IF  (I  .EQ.  6)  GTYPE  =  ’7-Pcrf.  Cyl.’ 

IF  a  EQ.  7)  GTYPE  =  ’7-Pcrf.  Hex.’ 

IF  0  EQ.  8)  GTYPE  =  ’19-Perf.  Cyl.’ 

IF  (I  .EQ.  9)  GTYPE  =  ’19-Pcrf.  Hex.’ 

IF  (1  .EQ.  10)  GTYPE  =  ’37-Pcrf.  Hex,’ 

IF  (I  .EQ.  11)  GTYPE  =  ’Cord  Inh.  End’ 

IF  0  EQ.  12)  GTYPE  =  ’Sandwich’ 

IF  a  EQ.  13)  GTYPE  =  ’Cigarette’ 

RETURN 

END 

Q*  4i«4i  4i(i4i  4i  4i  4i  4i  4>  4i  4i  4i4444i  4i  41*41 4i  4i  4i  4i  4i  41 4i  4i  4i  4i44i44i4*4i  ik4i4i*4i  4i4i  414  4i4i4i4i4i4i*4i4i4i4i4i  414441441  ikili** 
^*44*4*4444*44444444*44444  SUBROUTINE  GRAIN  444444444444*4444444444444*4 
^*44*444444*44444444*44*44444444444*4*4444444444444444444*4*444444*44444 

SUBROUTINE  GRAIN  (TYPE) 
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COMMON  A3  (100),  P  (11,  15.  5) 


^  4>  1)1 41*  III  *  4i  *  4>  <1  ********  4i  *  4>  *  >(<4>  4>  ****  4>  4>  4' >t<4' 't' >l<  *  4< «  4>  *  >•■<•<  <i<  *  4<  *  4>  *  4>  4>  <•■•>*<•<  4>  *  **  4>  w 


C  Version;  3.0,  January  1992 
C 


C  This  subroutine  will  interactively  ask  the  user  for  information 
C  concerning  the  geometry  of  the  propellant  being  used  in  the 
C  analysis. 


Q  4i  4i  4i  4i  41 4i  4i  4i  4i  4i  4i  4<  4i  41 4i  4i  4i  *  4i  4i  *  4i  4i  4i  4<  4i  4|  4i  4|  *  4i  4i  4|  4i  41 4|  4|  41 4i  4|  4|  4i  4|  4i  *  *  *  *  4i  *  4|  *  4|  4|  4i  4i  4|  4i  *  4<  *  4i  *  *  m  4|  4i  4i  4i  4i  4| 
(;<4i4i**4i4i4<4i4i4i4i4i4>  Setting  gtUin  dimensions  to  zero  4i4i*4i4i*4i*4.4i4i4<4.4i4i4i4i4i*4.*4i4i4i 
Q  4i  4i  4i  4i  *  4i  4i  4i  4<  4<  4i  4i  4i  4i  4i  4i  4i  4|  4i  *  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4|  4|  4i  *  4i  4t  4i  4|  4>  4|  4i  4i  4i  4|  4i  4i  4|  4i  4i  4|  4i  4|  4>  4i  4i  4i  4i  4i  4i  4i  4i  41 4|  m  4|  4i  *  4i  4i  4i  4i 


DO  1000  I  =  7,  12 
A3  a)  =  0.0 


1000  CONTINUE 
CALL  CLEAR 

^  4i  4i  4i  4i  4i  4<  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i 
C***********  INPUT  FOR  A  RECTANGULAR  STRIP  GRAIN  4.4.4i4.4i4.4.4.4i4.4i4i4i4.4i4i4.4i4i4i4.4i4. 
^  4i  41 4i  *  4|  4<  4i  4i  4i  41 4i  41 4>  4i  4|  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  *  4|  4i  4i  4|  4i  4|  4i  4i  *  4i  4i  4i  4i  4i  4i  4|  4i  *  4|  4i  4i  4>  4i  4i  4i  4i  4i  4|  4i  4i  4i  4<  4|  *  4i  4i  4>  4<  4i  4i  4i  4i  *  4i  4i 


IF  (OTYPE  .EQ.  3)  .OR.  (ITYPE  .EQ.  12))  THEN 
IF  (ITYPE  .EQ.  12)  THEN 

WRITE  (*,  *)  ’For  the  sandwich  grain,  burning  is  only’ 

WRITE  (*,  *)  ’on  the  top  and  bottom  surfaces.  These’ 

WRITE  (*,  *)  ’surfaces  are  determined  by  the  length’ 

WRITE  (*,  *)  ’and  thickness.  Burning  is  parallel  to’ 

WRITE  (*,  *)  ’the  width  dimension.’ 

WRITE  (•.  *)  ’  ’ 

END  IF 

WRITE  (*.  *)  ’Enter  the  Ungth:  ’ 

READ  (*.  •)  A3  (7) 

WRITE  (*.  *)  ’Enter  the  Width:  ’ 

READ  (*.  •)  A3  (8) 

WRITE  (*,  *)  'Enter  the  Thickness:  ’ 

READ  (*,  *)  A3  (10) 

RETURN 
END  IF 

Q4i4i*4i4i4i***4r»4i4i4i4i4i**4i4i4i4i4i4i<k*4i*4i4i4i4i4i4i4i«4i4i4i4i4i****4i4i4i4i4i4i4i4i4i4i4i*4i4i4i4i4i4i4i4i4i4i4i4i4i4i 

C**  INPUT  OF  THE  GRAIN  DIAMETER  -  REQUIRED  OF  ALL  REMAINING  GRAINS  **** 

^4i4i4i*4i4i4i4i4r*4i***4i*4i4i4i4i4i4i*4i*4i*4i****4i4i4i4i4i4i4i*4i4i4i*4i4i*4i4i4i4i4i4i4i4i4i4i4i4i4i4i*4i4i4i4i4<4i4i4i4i 

WRITE  (•,  *)  ’Enter  the  Grain  Diameter:  ’ 

READ  (*.  •)  A3  (8) 

Q*4<*«i»4i4i4i4i*«i4i4i4i***4i*******4i*4i4>**4i4i4i*4i****4i4i4i4i4i4i4i4>4<4>4i4i*4i4i4i4i4i4i4i4i4i4i4i*4>4i4i4i*4i 

C*********  TEST  FOR  SPHERE  GEOMETRY  -  ONLY  NEED  DIAMETER  •**4i****4i***** 

C****4i*****4i************4i*******4i***4i****<i<i*******4i«i4i***4i********4i4.*4.*4i4i 

IF  (ITYPE  .EQ.  1)  RETURN 


^4i4i**4i4i4i4i4i4i4i4i*4i4i*4i*4i4i4i4i4i4i4i4i*****4i*4i**4i*4i*4i4i4i*4i**4i4i4i4i4>4i4i4i4i4i4i4i***4i4i4<4>4i4<4>4i4i 

C4.***4<4.4i*»4i*********  INPUT  OF  GRAIN  LENGTH  **********************4.4i** 
. . . . . 


WRITE  (•,  *)  ’Enter  the  Grain  Length;  ’ 
READ  (•,  •)  A3  (7) 
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^  41  itiili  i|ii|i  *  *  Id  *  «  *  it>  >t>  *  4>  *  <ti  4i  *  *  *  <li  *  *  *  4>  i|>  4<  <•  Ik  III  *  4>  4>  *  >|i  Hi  »  <1  <1  *  >l<  *  *  4i  *  *  %  4i4i  4i  4i  #  4>  *  «  4>  4ri|i  *  *  itc  4i  4i «  4t  «■  * 

C******  TEST  FOR  CORD  GEOMETRY  -  ONLY  NEED  DIAMETER  AND  LENGTH  ******** 

^  4i  4i  4i  4i  4i  4<  4i  4i  Id  4i  *  4i  4>  Id  *  4i  4>  4i  4<  4<  4i  4i  4i  4i  4<  4i  *  4i  4i  4<  *  4i  4<  4i  *  4i  *  d  4i  *  4i  4i  d  4i  d  d  4i  d  d  4<  4i  d  4i  *  4i  4i  4i  4i  4i  4i  d  4i  4i  4i  4i  4>  d  4i  4<  4i  4< 

IF  (aTYPE  .EQ.  2)  .OR.  (TTYPE  .EQ.  11)  .OR.  (ITYPE  .EQ.  13)) 

1  RETURN 

^ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 

^dddddddddddddddddd  INPUT  OF  PERF  DIAMETER  ***************************** 

^d*d***ddddd*dd*d*dd*******d*********d*****d*******d************d*d*d**d 

WRITE  (*,  *)  'Enter  the  Perf  Diameter:  ’ 

READ  (*,  *)  A3  (9) 

^dddddd*ddd******dd**d******dddd*d***d*******d********************d*d**d 

(^dddddddddddddddd  SPEQAL  INPUT  FOR  SLOTTED  TUBE 

dddddddddddddddddddd**** 

^dd*******dddddddddddd*d*ddd*******d***d****d******d********d**dd******d 

IF  (TTYPE  .EQ.  5)  THEN 
WRITE  (*.  *)  'Enter  the  Slot  Width:  ' 

READ  (*,  •)  A3  (11) 

RETURN 
END  IF 

^d*ddd*dd*dd**d***d**d*d*ddd****d**********d**d**d*d************d***dd*d 

^d*dd*ddd***ddd*d*d*ddd  INPUT  OF  INNER  WEB  ***************************** 

^dd***d*d****dd*d*d****d*dd*dddd*dd*dd******d*d**d*d*d************d*d*dd 

WRITE  (*,  *)  'Enter  the  Inner  Web:  ’ 

READ  (•,  •)  A3  (10) 

^ddddd*ddd*d*d***ddd*d**d****d*ddd****d*******d*dd*dd*dd*******dd**ddddd 

C****  test  FOR  SINGLE  PERF  GEOMETRY  -  NO  ADDITIONAL  INPUT  REQUIRED  ***• 

0****d*******d****dd*d***d*ddddddd**ddd*****d****d*d*dd*d*d*dd**d*d*d*dd 

IF  (TTYPE  .EQ.  4)  RETURN 

^d*d**d*ddddd*ddddddd*******d*dd*dd**d*d****ddd****d*ddddddd**d*d**dd*** 

^dddddddd  test  for  seven  perf  GEOMETRY  -  MIDDLE  WEB  NOT  NEEDED  ******** 

^ddddddddd***d*d**d********dddddddd*d**d******d****d*dd***dddd**d**dd**d 

IF  (GTYPE  .EQ.  6)  .OR.  (TTYPE  .EQ.  7))  GO  TO  1010 

^d*dddd**dd*dddd***d*d*d*d***d*dd*d*dddd****dd***d*d****d****dddd*dddd*d 

^dddddddddddddddddddd  INPUT  OF  MIDDLE  WEB  dddddddddddddddddddkdddddddddd 

^ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 


WRITE  (*.  *)  'Enter  the  Middle  Web:  ’ 

READ  (*,  •)  A3  (11) 

^ddddddddddddddddddddddddddddddd*ddddddddddddd*ddddddddddddddddddddddddd 

^dddddddddddddddddddddddd  INPUT  OF  OUTER  WEB  ddddddddddddddddddddddddddd 


1010  CONTINUE 

WRITE  (•,  •)  'Enter  the  Outer  Web:  ' 

READ  (*.  •)  A3  (12) 

RETURN 

END 

^ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 

(^ddddddddddddddddddddddddd  SUBROUTINE  CKGRAIN  d*dddddddddddddddddddd. 

. . dddddddddddddddddddd* . . 
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SUBROUTINE  CKGRAIN  (ITYPE) 
COMMON  A3  (100),  P  (11.  15.  5) 


^  4i  «>  *  *  «  «  *  *  *  *  *  «  *  « *  *  *  *  *  «  *  Hi  *  Hi  «  4i  *  «  4. 4.  *  *  Hi  Id  4i « IK  m  «  «  *  *  *  Hiiti  4.  Ik  *  %  *  *  4>  4"l> 


C  Version:  3.0.  January  1992 
C 


C  This  program  will  check  to  determine  if  the  entered  values  for  the 
C  grain  geometry  are  correct.  The  error  tolerance  is  1%.  If  the 
C  geometry  is  not  within  1%  then  the  webs  are  adjusted  to  make  the 
C  geometry  consisted.  The  user  is  prompted  as  to  accept  the  new  grain 
C  geometry  or  keep  the  original  values. 

^4i4i4iiK4i«i4i4i*4i*4i4i4i4i4iiK4><K****4i*«i4i<KiK*>i>«i**>^iK4'*4")i4i4i*>«>**4>iK4>4i4i4i4i*iKiK*iK«iK>K*<<4i4i4i4iiKiK** 

C******  NO  CHECKING  IS  DONE  FOR  CORD.  RECTANGULAR  STRIP.  SPHERE,  OR 
Q4i***4i4iiK4i*4i4i4i***iK4i4i4i*****4i**  SLOTTED  TUBE.  ****'<‘*<«'**'*4"l‘****»'*«‘4‘')‘'l‘******* 


Q4i4i4i*4i4i«*4i4i*iKiK4i*«>K4t4i4i4i«*>K*»*iK4i4i4i<K4i**iK*iK*iK*4i4i>KiK4i*iKiKiK4iiK4<**>KiKiKiKiKiKiK4iiK*4<*iK*<li<l> 


XL  =  A3  (7) 

XD  =  A3  (8) 

XPD  =  A3  (9) 

XIW  =  A3  (10) 

XMW  =  A3  (11) 

XOW  =  A3  (12) 

IF  (GTYPE  .EQ.  1)  .OR.  (ITYPE  .EQ.  2))  RETURN 
IF  (OTYPE  .EQ.  3)  .OR.  (ITYPE  .EQ.  5))  RETURN 
IF  (ITYPE  .GE.  11)  RETURN 

Q«iK*iK*iK4iiK*4i>l>*******4>*ik4<*4i*****)K**iKiK4i4i4i4i*4i**iKiK<K***4i4<*4i4>i|ii*iiK**>K********iK4i*<K 


^«**ik4i**ik«i4i*«i4i**«*4i  CHECKING  A  SEVEN  PERF  GRAIN  ****>*'****'***4"*'*'*>'<"t'**'*"«<*'i> 

^«**«***iK4iiK**4>*«**4i**>k**4i****4i«i»4iiK****iK**«i*4i4iiK*4iiKiKiK**4i4<4>«iiK>KiK*iK****4>4tiK4'4>4' 


IF  ((ITYPE  .EQ.  6)  .OR.  (ITYPE  .EQ.  7))  THEN 
XDT  =  3  *XPD  +  2.*(XIW  +  XOW) 

DELTA  =  XDT  -  XD 
IF  (ABS  (DELTA/XD)  .GE.  0.0001)  THEN 
XIWT  =  XIW  -  DELTA/4. 

XOWT  =  XOW  -  DELTA/4. 

XMWT  =  XMW 
GO  TO  1000 
END  IF 
RETURN 
END  IF 


Q4i4i4i4i4i*4i4i*4i4i**4i4i«i**4i4r4i*i*4i4i4i«i4i4i4i4i4i«i4i4i4i4i4i**4i4i4i4i**4iK*4i4i4i:K4'4i««4i**4'**iKiK4<**4i** 

QKK*K*4i«iiK4i4i4i4i*4iK4i  CHECKING  A  SINGLE  PERF  GRAIN  ************************* 

^4i4i4i«i*4i«i*4i4i*K*44iK4i4i4i4i*4iK4i*iK4i4i4i«i4i*4i4i*4i4i4i«4iiK4i4i4iKiK4iK4<*4i*KK4i4i4<4i4<4i4i4i4i*4iiKiK4i4iiK4i 

IF  (ITYPE  .EQ.  4)  THEN 
XDT  =  XPD  +  2.^XIW 
DELTA  =  XDT  >  XD 
IF  (ABS  (DELTA/XD)  .GE.  0.0001)  THEN 
XIWT  =  XIW  -  DELTA/2. 

XMWT  =  XMW 
XOWT  =  XOW 
GO  TO  1000 


Ki*** 
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END  IF 
RETURN 
END  IF 

Q  Hr  *  i|n|i  Hi  O  «<  i|<  «•  Id  1)1  *  m  *  *  Iciti  *  *  *  Hi  *  *  *  *  *  *  «  «  umi  4r>|f  *  >l> «  *  iliiliKt  *  He  *  it<  4iit>  *  it<  Hi  *  Hi  *  *  4ii|<  « Id  *  *  *  *  *  *  *  4i  41*111 

^*****************  checking  a  37-PEFR  HEX  GRAIN  ♦♦f********************* 

Q****************************************]).****************************** 


IF  (TTYPE  .EQ.  10)  THEN 
XDT  =  7.*XPD  +  6.*XIW  +  2  *XOW 
DELTA  =  XDT  -  XD 

IF  (ABS  (DELTA/XD)  .GE.  0.0001)  THEN 
XIWT  =  XIW  -  DELTA/8. 

XOWT  =  XOW  -  DELTA/8. 


XMWT  =  XMW 
GO  TO  1000 
END  IF 
RETURN 
END  IF 

^*********************************************************************** 
^*********************  CHECKING  19-PERF  HEX 
^*********************************************************************** 


IF  (TTYPE  .EQ.  9)  THEN 
XDT  =  5.*XPD  +  4.*XIW  +  2.*XOW 
DELTA  =  XDT  -  XD 

IF  (ABS  (DELTA/XD)  .GE.  0.0001)  THEN 
XIWT  =  XIW  -  DELTA/6. 

XOWT  =  XOW  -  DELTA/6. 


XMWT  =  XMW 
GO  TO  1000 
END  IF 
RETURN 
END  IF 

^***************************************************1)1******************* 

^***********************  CHECKING  19  PERF  ******************4<*********** 
0*********************************************************************** 


IF  (TTYPE  .EQ.  8)  THEN 
XDT  =  5*XPD  +  2.*(XIW  +  XMW  +  XOW) 

DELTA  =  XDT  -  XD 

IF  (ABS  (DELTA/XD)  .GE.  0.0001)  THEN 
DELTA  =  DELTA/6. 

XIWT  =  XIW  -  DELTA 
XMWT  =  XMW  -  DELTA 
XOWT  =  XOW  -  DELTA 
GO  TO  1000 
END  IF 
RETURN 
END  IF 

^********«*****************************************«******************** 
^*********  USER  IS  ALLOWED  TO  ACCEPT  OR  REJECT  NEW  DIMENSIONS  ********** 
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^  4>  <1  *  *  *  4i  4i  4i4i  4i  Dciti  *  4i  4<  *  «  *  *  *  He  4i  4iit>  Hi  IK  4i  *  *  *  *  *  *  *4) «  Hi  *  4«K  it<  *  *  «<  *  *  4>  Ik  4>  %  If  »■ «  *  K  *  *  *  *  «#  4i  4c  4cit>  *  *  4<  *  *  * 

CALL  CLEAR 
1000  CONTINUE 
WRITE  (*,  *)  ’  ’ 

41)  .  . 

*)  ’WARNING!!  The  grain  geometry  entered  is  not’ 

WRITE  (*,  *)  ’consistent.  ITie  following  values  have  been’ 

WRITE  (*,  *)  ’recomputed  for  the  grain  geometry.’ 

WRITE  (♦.  *)  ’  ’ 

WRITE  (*.  6000)  XL.  XD.  XPD,  XIWT.  XMWT,  XOWT 
6000  FORMAT(’  Grain  Length  :  ’,F10.5y. 


WRITER, 
WRITE  (* 


1 
2 

3 

4 

5 

WRITE  (*. 
WRITE  (*. 
WRITE  (*. 
WRITE  (*, 


*) 

*) 

*) 

*) 


Diameter  :  ’J^10.5y, 

Perf  Diameter:  ’,FI0.5y, 

Inner  Web  :  ’JF10.5y. 
Middle  Web  :  ’.F10.5y. 
Outer  Web  :  ’.F10.5) 

1.  Accept  New  Geometry’ 

2.  Retain  Values  as  Entered’ 


WRITE  (*,  *)  ’  Please  Enter  Your  Choice:  ’ 

READ  (*,  *)  ICHOICE 
IF  aCHOICE  .EQ.  2)  RETURN 

^iK4i4iiK4i4<4iiK4i**4i4i4c*4iiK4iiKiK4i4i4i4i4i4i**iKiK4'4iiK4c4c4i4i*4i4i4i4i4i4i4<iK4<4i4i4c4i4c4i4i4t4<4>4iiK4i4i4i4iiK4c4i4iiK4>4i* 

^4<4i4<*4.4i4i4<4i4i4iikiK4i4i<k4<4>  CHANGING  VALUES  TO  NEW  GEOMETRY  ******************** 

Q4i4i4<4'**<K4i4i**4i4iiK*iK4«k4i4i****>K4i4i4i4>4i4<4i4i4i*4i4i4i4>4i*4i4>4i4i4i4iiKiKiKiK4i4i4i4i4>*4i4i4iiK4ciKiK4i4iiKiK4i4i4i 

A3  (10)  =  XIWT 
A3  (11)  =  XMWT 
A3  (12)  =  XOWT 
RETURN 
END 

Q  4>  *  4<  *  *  *  «  4i  4<  4<  4<  4i  Ik  4i  4<  4i  4i  4i  4i  4i  Ik  4i  4<  Ik  4i  4i  4i  4<  4<  4i  4i  4i  4c  Ik  4' 4c  4<  4<  4i  4»K  41 4c  4i  4c  Ik  Ik  4i  4<  4i  4i  4>  4i  4i  4i  4c  4i  4<  4c  4>  4<  4>  4<  4c  Ik  4<  4i  4i  4i  4i 

Q4c4cik4c4i4c4i4cikikik4c4c4c4c4c4c4c4c4c4c4c3yQ]^Q^JppS(Q  LAYDET  4c 4c 4c 4c 4c 4c 4c 4c ik ik 4c ik 4i 4c 4c 4c 4c 4c 4- 4c 4c 4c ik 4c 4c 4c 4c 4c 4c 4i 4c 

0  4c  4c  4c  ck  4c  4c  4c  4c  *  4i  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c 

SUBROUTINE  LAYDET 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  Ik  Ik  4c  Ik  4c  4c  4c  4c  4i  4i  4i  *  4c  4c  4c  Ik  Ik  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c 

C  Version:  3.0,  January  1992 
C 

C  Purpose:  This  program  provides  the  necessary  utilities  to  prepare  the 
C  files  for  use  with  layered/deterred  propellant. 

(j^4c  4c  4c  4c4c  4c  4c  4c  4i  4c  4c  ik4c**4c  4c4  4c  4c  4c  4c  4c  4c  4i  4c  4i4c4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  41 4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c 

COMMON  A3  (100),  P  (11.  15.  5) 

CALL  CLEAR 
WRITE  (*,  6000) 

6000  FORMAT(/////) 

WRrUE  C",  *)  ’Enter  the  number  of  layers  (1  -  15)’ 

READ  (*.  •)  NUMPT 
A3  (4)  =  NUMPT 
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P(l.  1.  1)  =  0.0 

IF  (NUMPT  .EQ.  1)  GO  TO  1000 
WRITE  (*.  *)  ‘  ’ 

WRITE  (*,  *)  ‘Enter  the  starting  depth  for  each  layer.* 

WRITE  (*,  *)  ‘The  first  layer  starts  at  a  depth  of  0  cm.’ 

WRITE  (*,  *)  ‘and  will  be  automatically  entered.  The  ’ 

WRITE  (*,  *)  ’last  layer  must  start  at  a  depth  no  deeper’ 

WRITE  (*,  *)  ’than  one-half  the  length  of  the  anallest’ 

WRITE  (*,  *)  ’web,  i.e.  no  slivering  may  occur  except  in’ 

WRITE  (*,  *)  ’the  inner  layer  of  the  grain.’ 

WRITE  (*.  *)  ’  ’ 

DO  1010  J  =  2,  NUMPT 
WRITE  (*,  6010)  J 

6010  FORMAT(5X,’Enter  beginning  depth  for  layer  ’,12,’.’) 

READ  (*,  *)  P  (1,  J,  1) 

1010  CONTINUE 
1000  CONTINUE 

^  *  I|<  4>  *  Id  «  m  *  *  4t  4|  *  «  4> «  «  4, *  4i «  *  «  «  4. «  «  4. 4<  4. 4c  <1 «  «  4, 4,  He  4, 41  *  %  « Id  4, 4I « *  4, 4, 4, «  4, «  «  *  «  4, 4, «  *  4,4, 

(2<4<4<4»d4<4«d4>4<*4<4<4>4<4>4<  Thermochemcial  information  entered  ******************* 

^4<4>4<4>4>4<4<4<4>4<4i4>4<4<4>4>4>4i4<4'*4c4c4>4i4>4c4>4i4i4i4c4i4i4t4'4i4i4>4c4"d4<4c4i4i4i4i4>4>4<4<4>4c4c4ci-.i4>4c4>4c4<4c4>4c4i4c4<4<4i4< 

CALL  CLEAR 

WRITE  (*,  *)  ’  Thermochemical  Properties’ 

WRITE  (*,  *) 

WRITE  (*,  •)  ’  1.  Constant  properties  in  each  layer’ 

WRITE  (*,  *)  ’  (Use  for  standard  and  layered  grains)’ 

WRITE  (*,  *) 

WRITE  (*,  *)  ’  2.  Varying  properties  in  at  least  one  layer’ 

WRITE  (*,  *) 

WRITE  (*,  *)  ’  Enter  your  choice’ 

READ  (*,  *)  IGHR 

IF  ((IGHR  .EQ.  1)  .AND,  (NUMPT  .EQ.  1))  THEN 
A3  (31)=  1. 

ELSE 

A3  (31)  =  2. 

END  IF 

IF  aOHR  .EQ.  2)  THEN 
A3  (31)  =  0.0 
END  IF 
CALL  CLEAR 
IF  (IGHR  .EQ.  1)  THEN 

WRITE  (*,  •)  ’Values  will  be  entered  for  each  layer.  ’ 

WRITE  (*,  *)  ’All  input  values  are  to  be  in  metric  units.’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’  ’ 

PAUSE 

ELSE 

WRITE  (*,  6000) 

WRITE  (*,  *)  ’Values  will  be  entered  for  the  beginning  and’ 
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WRITE  ("■,  *)  ’end  of  each  layer.  All  input  in  metric  units.’ 
WRITE  (*,  *)  ’For  any  layer  there  should  be  no  more  than  a’ 
WRITE  (*,  *)  ’20%  variation  in  any  property.’ 

WRI'TE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’  ’ 

PAUSE 
END  IF 

DO  1020  KK=  l.NUMPT 
CALL  CLEAR 
IF  (IGHR  .EQ.  1)  THEN 
WRITE  (*,  6020)  KK 

6020  FORMATC  ’.’Rame  Temperature  (K)  for  layer  ’,12.’  :’) 

READ  (*.  *)  P  (3,  KK.  1) 

P  (3.  KK.  2)  =  P  (3.  KK.  1) 

WRITE  (*.  6030)  KK 

6030  FORMAT(/.’  ’.’Impetus  (J/g)  for  layer  ’,12.’  :’) 

READ  (*.  *)  P  (2,  KK.  1) 

P  (2.  KK.  2)  =  P  (2.  KK.  1) 

P  (5.  KK.  1)  =  8.314*P  (3.  KK.  1)/P  (2,  KK,  1) 

WRITE  (*.  6040)  KK.  P  (5.  KK.  1) 

6040  FORMAT(/,’  ’.’A  consistent  Molecular  Weight  for  layer  ’,12, 

1/’  given  the  Flame  Temperature  and  Impetus  is:  ’,F8.4, 

2/’  (Accept  =  1,  Enter  new  =  2)  Enter  choice’/) 

READ  (*.  *)  IVHE 
IF  (IVHE  .EQ.  1)  THEN 
P  (5.  KK.  2)  =  P  (5.  KK,  1) 

ELSE 

WRITE  (*,  *)  ’Enter  the  Average  Molecular  Weight:’ 

READ  (*,  *)  P  (5.  KK.  1) 

P  (5,  KK,  2)  =  P  (5,  KK,  1) 

END  IF 

WRITE  (*.  6050)  KK 

6050  FORMAT(’  ’, ’Covolume  (cc/g)  for  layer  ’,12,’ :’) 

READ  (*,  *)  P  (6,  KK,  1) 

P  (6,  KK.  2)  =  P  (6.  KK.  1) 

WRITE  (*,  6060)  KK 

6060  FORMAT(’  ’.’Gamma  for  layer  ’,12.’ :’) 

READ  (*,  •)  P  (7.  KK.  1) 

P  (7.  KK,  2)  =  P  (7.  KK.  1) 

WRITE  (*.  6070)  KK 

6070  FORMAT(’  ’.’Density  (g/cc)  for  layer  ’.12.’  :’) 

READ  (*,  *)  P  (4.  KK,  1) 

P  (4,  KK.  2)  =  P  (4.  KK.  1) 

ELSE 

WRITE  (*.  6080)  KK 

6080  FORMATC  ’.’Flame  Temperature  for  layer  ’,12,’  begirming  (K):’) 
READ  (*,  •)  P  (3.  KK.  1) 

WRITE  (*,  6090)  KK 
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6090  FORMATC  ’.’Flame  Temperature  for  layer  ’.12,’  at  end  (K):’) 
READ  (*,  *)  P  (3.  KK.  2) 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  6100)  KK 

6100  FORMATC  ’.’Impetus  for  layer  ’,12,’  at  beginning  (J/g):’) 
READ  (*,  *)  P  (2.  KK.  1) 

WRITE  (*,  6110)  KK 

6110  FORMAT(’  '.’Impetus  for  layer  ’,12,’  at  end  (J/g):’) 

READ  (*.  *)  P  (2.  KK.  2) 

WRITE  (*.  *)  ’  ’ 

WRITE  (*.  6120)  KK 

6120  FORMATC  ’, ’Molecular  Weight  for  layer  ’,12,’  at  beginning  :’) 
READ  (♦,  *)  P  (5,  KK,  1) 

WRITE  (*.  6130)  KK 

6130  FORMATC  ’.’Molecular  Weight  for  layer  ’,12,’  at  end:’) 

READ  (*,  •)  P  (5,  KK,  2) 

WRITE  (*,  *)  ’  ’ 

WRITE  (*.  6140)  KK 

6140  FORMATC  ’,’Covolume  for  layer  ’,12,’  at  beginning  (cc/g):’) 
READ  (*,  •)  P  (6.  KK,  1) 

WRITE  (*,  6150)  KK 

6150  FORMATC  ’, ’Covolume  for  layer  ’,12.’  at  end  (cc/g):’) 

READ  (•.  *)  P  (6,  KK,  2) 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  6160)  KK 

6160  FORMATC  ’.’Gamma  for  layer  ’,12,’  at  beginning:’) 

READ  (*,  *)  P  (7.  KK,  1) 

WRITE  (*,  6170)  KK 

6170  FORMATC  ’.’Gamma  for  layer  ’,12,’  at  end:’) 

READ  (*,  *)  P  (7,  KK,  2) 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  6180)  KK 

6180  FORMATC  ’.’Density  for  layer  ’,12,’  at  beginning  (g/cc):’) 
READ  (*,  •)  P  (4.  KK.  1) 

WRITE  (*,  6190)  KK 

6190  FORMATC  ’.’Density  for  layer  ’,12,’  at  end  (g/cc):’) 

READ  (*,  *)  P  (4,  KK,  2) 

END  IF 

P  (9.  KK.  1)  =  1.98717/P  (5,  KK.  1) 

P  (9.  KK.  2)  =  1.98717/P  (5.  KK.  2) 

P  (10.  KK.  1)  =  P  (9.  KK.  1)/(P  (7.  KK.  1)  -  1.) 

P  (10.  KK.  2)  =  P  (9,  KK,  2)/(P  (7.  KK.  2)  -  1.) 

P  (11,  KK.  1)  =  P  (10.  KK,  1)*P  (3.  KK.  1) 

P  (11.  KK.  2)  =  P  (10.  KK.  2)*P  (3,  KK.  2) 

1020  CONTINUE 
RETURN 
END 


0**41*41 4i*4iili*i|i***4iiti  i|i4i  4)  itri|<itc4^  III  4<4<4>4>«> 
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SUBROUTINE  MAXDEPTH  ***************'i'************** 

^  *  *  *  «  *  *  *  *  *  *  Kiiliiti  **  *  «  *  *  *  *  <1  *  «>  *  *  Id  *  It>  *  *  *  4>  *  *  *  *  *  *  *  Hi  *  «  «  *  *  «  *  *  *  *  *  *  *  *  Hi  %  4<  Ik  41  Itc «  *  *  *  * 

SUBROUTINE  MAXDEPTH 
COMMON  A3  (100),  P  (11.  15.  5) 

ITYPE  =  A3  (45) 

^  *  Kiiliili  Id  *  *  *  *  4i « Id  *  *  Id  Hi  *  4i  Id  *  Id  *  *  *  *  4iid  *  *  *  Id  *  *  Id  *  *  «  «  *  *  «  Ki  *  *  Hi  *  Olid  *  *  *  Id  4>  4>  *  *  *  Id  *  4i4iid  Ik  *  Id  41 «  4>  * 

(^4i4i4i4i*4i4i4.4iid4i4<4i4<4i4i4i  GRAINS  FOR  WHICH  THE  DEPTH  CAN  BE  SOLVED  n*********** 

^4i4id4i4i4i4i4i4i4i4i4i4i4i4i4iid4i4i4i4i4i4i4i4i4i4i4i4i4i4iidid4i4i4i4i4i*d4i4i4i4iid4i4i4i4i4i4iid4i4i4i4i4i4i4i4i4id4iid4i4i4i4i4i4i4i 


IF  (ITYPE  .EQ.  1)  THEN 
A3  (1)  =  A3  (8)/2. 
RETURN 
END  IF 

IF  (ITYPE  .EQ.  2)  THEN 
X  =  A3  (8)/2. 

Y  =  A3  (7)/2. 

A3  (1)  =  MIN  (X.  Y) 
RETURN 
END  IF 

IF  (ITYPE  .EQ.  3)  THEN 
X  =  A3  (8)/2. 

Y  =  A3  (7)/2. 

Z  =  A3  (10)/2. 

A3  (1)  =  MIN  (X.  Y.  Z) 
RETURN 
END  IF 

IF  (ITYPE  .EQ.  4)  THEN 
X  =  (A3  (8)  -  A3  (9))/2. 

Y  =  A3  (7)/2. 

A3  (1)  =  MIN  (X.  Y) 
RETURN 
END  IF 

IF  (ITYPE  .EQ.  11)  THEN 
A3  (1)  =  A3  (8)/2. 
RETURN 
END  IF 

IF  (ITYPE  .EQ.  12)  THEN 
A3  (1)  =  A3  (8)/2. 
RETURN 
END  IF 

IF  (TTYPE  .EQ.  13)  THEN 
A3  (1)  =  A3  (7) 
RETURN 
END  IF 


^4i  4i  4i  4i  4i  4i  Id  Id  Id  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Id  4i  Id  4i  Id  4i  4i  4i  4i  Id  d  d  4i  Id  4i  Id  4i  4i  4i  4i  4i  4i  4i  Id  Id  4i  Id  Id  4<  d  4i  4i  4i  4i  Id  4i  Id  Id  Id  4i  4i  Id  4i  4i  4i  Id  Id  Id  Id  Id  4i  4i 

^ddddddddddddddddd  remaining  grains  are  handled  •♦♦■ddddddddddddddddddddd 

^ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 


R  =  MIN  (A3  (10)/2..  A3  (ll)/2..  A3  (12)/2..  A3  (7)/2.) 
B  =  MAX  (A3  (7)/2..  A3  (8)/2.) 
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B  =  B/10000. 

DO  10001  =  1,  10000 
R  =  R  +  B 

CALL  FORMT  (ITYPE.  SFAREA,  VOLUNB,  R) 

IF  (ABS  (VOLUNB)  .LE.  0.000001)  THEN 
A3  (1)  =  R 
GO  TO  1010 
END  IF 

1000  CONTINUE 

WRITE  (♦.  *)  ’THE  MAXIMUM  DEPTH  BURNED  CANNOT  BE  DETERMINED.’ 
WRITE  (♦.  ♦)  ’CHECK  GRAIN  GEOMETRY  AND  START  OVER.’ 

PAUSE 

1010  CONTINUE 
RETURN 
END 


c* 


QMHiinti****************  SUBROUTINE  FORMT  ********************************** 
C* 


c* 

C  ICODE:  code  for  type  of  grain 

C  R  :  bum  depth 

C  GL:  unbumed  grain  length 

C  D  :  unbumed  outer  diameter 

C  PD:  unbumed  perforation  diameter 

C  WI,  WM,  WO:  inner,  middle  and  outer  webs  respectively 

C 

C  Ou^ut: 

C  SFAREA:  surface  area 

C  FRCSFA:  surface  area/initial  surface  area 

C  VOLUNB:  unbumed  volume 

C  VOLBRN:  burned  volume 

C  FRCBRN:  burned  volume^nitial  volume 

C  VOLMAO:  unbumed  volume  of  outer  layer 

C  VOLMBO:  unbumed  volume  of  irmer  layer 

C  VOLABR:  burned  volume  of  outer  layer 

C  VOLBBR:  burned  volume  of  irmer  layer 

C 

Q  4i «  4i «  *  4i  *  Di  Ik  *  *  *  *  *  *  4i  null  *  *  Hi  4>  *  *  *  *  *  4i «  *  *  *  *  *  *  *  *  4ii|i  Hi  4i  4>  Ik  41*  *  4> «  *  41  *  *  *  *  *  *  *  *  If  *  *  *  *  *  *  *  *  4>  *  * 


SUBROUTINE  FORMT  (ICODE,  SFAREA,  VOLUNB,  R) 
COMMON  A3  (100),  P  (11,  15,  5) 

DIMENSION  S7  (4),  S19  (3,  4) 

DATA  RT/1 .732050808/,  PI3/1 .047 197551/,  PI/3.141592654/ 


Q  4i  4i  4i  4i  Ik  4i  Ik  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  Ik  4i  4i  4i  Ik  4i  Ik  4i  Ik  4i  4i  4: 4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Ik  4i  4i  4i  4i  4>  4i  Ik  >k  4i  Ik  Ik  4i  4i  Ik  4i  4i  4i 


^*ikikik4iikik4iikikik4i4i4i4i4<4i4i4i4i  GRAIN  GEOMETRY  *4i*4i4i*4i4i4i4i4i4i4iikik4iikikikikikik4iik4i4i4i4i4i4i4i 


^  *  *  4i  4<  4i  Ik  4i  4i  4<  Ik  Ik  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  Ik  4i  4i  Ik  4i  4i  Ik  4i  Ik  4<  4>  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Ik  Ik  Ik  4i  Ik  Ik  Ik  4i  Ik  4i  4i  4< 


GL  =  A3  (7) 
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D  =  A3  (8) 

PD  =  A3  (9) 
WI  =  A3  (10) 
WM  =  A3  (11) 
WO  =  A3  (12) 


41 «  Hi  Hiilc*  4i  *  4i  4i  *  *41 4> «  «  «  «  Hi  i|<  *  *  «  *  *  **  mill  4<  i|<  *  *  *  Hiitcili « iK  4i «  *  *  4i  O  *  *  *  *  Hi  *  A*  *  «  He  *  iloK  i|»ti 

C********  Set  U  =  2*(depth  burned)  and  branch  to  grain  type  ************ 

^4i4i4i4i*4c**4>4>************4i*****4>******4i**********%4<4>*****4<****4i*****4>***** 

U  =  2.0*R 

^4i*********4<***********4>************4>**********4i*************4<****4>*4i*** 

^4<**************4<******  CIGARETTE  GRAIN  ******************************** 

^4i4<**4<****************************************************************** 


IF  qCODE  .EQ.  13)  THEN 
SFAREA  =  PI*D*D/4 
VOLUNB  =  (GL  -  R)*SFAREA 
RETURN 
END  IF 

^4i4<**4<*4i*********************4<*****************4<************************ 

(2;4<****************  all  other  GRAINS  ARE  HANDLED  ************************ 

^4i4>***************************************«****4>************************ 


GO  TO  (  1000,  1010,  1020,  1030,  1040,  1050,  1060,  1070, 

1  1080,  1090,  1100,  1110),  ICODE 

^4<**************4<*********************:»********4i*******4>**************** 

^*4i*******4<*********  CODE  1 :  7-PERF  GRAIN  **************************** 

^4<********************4i*****************4>******4>************************ 

C***  This  part  calculates  the  conditions  before  the  grain  bums. 

^4>**«*4>*********4<*****4>******4>************4>*4<**4i4<4>*****4<**************** 

1050  CONTINUE 

D  =  3.0*PD  +  2.0*(AVI  +  WO) 

EO  =  PI*(D**2  -  7.0*PD**2)/4.0 
SO  =  PI*(D  +  7.0*PD)*GL  +  2.0*E0 
VO  =  E0*GL 
WW  =  WI  +  PD 
DO  1120  K=  1.  3 
S7  (K)  =  WW 
1120  CONTINUE 

WEBC  =  AMINl  (WO,  WI,  GL) 

^4>********************4<*******4>*****4i*****4>****4i4<*****4>4<*****«********** 

C***  This  part  does  the  calculations  for  the  burning  grain. 

^4>***4i*****>l>******************4'***********************4<***************** 

GRL  =  AMAXl  (GL  -  U,  0.0) 

OD  =  D  -  U 

PRFD  =  PD  +  U 

IF  (U  .GT.  WEBC)  GO  TO  1130 

E  =  PI*(OD**2  -  7.0*PRFD**2)/4.0 

SFAREA  =  PI*(OD  +  7.0*PRFD)*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  E*GRL 
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VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
REIURN 

C***  This  part  does  the  calculations  for  when  the  grain  slivers.  '''***** 

^  Id  Di  *  He  4|  *»  «  *  *  «  «  *  *  4>  4>  *  «  *  *4: «  *  *  Hi  *41  *  4i  IK  Di «  *  Id  1)1 4> «  «  «4>  *  4>  4> «  «  4>  *  #  *  «  *  «  *  4<  >t<  »< '«<  *  >l«t<  *  *  *  « 

1130  CONTINUE 

CALL  GENIS  (S7,  PRFD,  GRL,  SFl,  GVl) 

CALL  GENOS  (S7.  PRFD,  GRL.  0.5*OD.  SF2.  GV2) 

SFAREA  =  6.0*(SF1  +  SF2) 

FRCSFA  =  SFAREA/SO 
VOLUNB  =  6.0*(GV1  +  GV2) 

VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRNA^O 
RETURN 

^Id4<id4<id4>4i4i***4i4iididid4iididididid***4'4<4i4i4i4i4i*id4iidididididididid*4<id4'*4»did*4>*id4<ididididid*ididid4iid4i4iid4< 

^4i4<4i*4i4i4i*4i4>id4<4iid4iid4i4>id  CODE  2:  I'PERF  GRAIN  **************************** 

Q*Jtt*****************************:**************************************** 

C***  This  part  calculates  the  conditions  before  the  grain  bums. 

Q  4<  4i  4<  4i  4<  *  4i  *  4i  4i  4i  4i  4i  4i  *  4<  4i  4<  4i  *  *  4i  *  4>  *  *  *  *  *  *  *  *  4<  *  4i  4<  *  4i  4<  4i  *  *  4t  4i  4<  4i  4>  4>  *  4>  *  *  <!•  4<  4i  4i  4<  4c  4i  4>  *  4>  4<  *  4<  4<  4>  4c  *  *  Id 

1030  CONTINUE 
D  =  PD  +  2.0*WI 
EO  =  PI*(D**2  -  PD**2)/4.0 
SO  =  PI*(D  +  PD)*GL  +  2.0*E0 
VO  =  E0*GL 

WEBC  =  AMINl  (GL,  WI) 

C  4i  4c  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  Id  4c  Id  4i  4c  4c  4c  4>  4i  4i  <d  4<  4i  4c  4i  4i  4c  4i  4i  4i  4i  4i  4i  4c  Id  4c  Id  4c  Id  4c  Id  Id  4c  4c  Id  4c  4>  4i  Id  4c  4c  4i  4i  4i  4c  4i  4c  4c  4c  4c  4c  4i  Id  Id  Id  4> 

C*******  This  part  does  the  calculations  for  the  burning  grain.  ******* 

^'4c  4c  4c 4c 4c  4i  4c 4i  4i  4i  Id  4c  4i  4c Id 4c 4c  4c 4c  4c  4c  4c  4c  4c  4c 4c  Id 4c 4c  4c  4c  4c 4c  4i  4c  4c  4c  4c  4c 4c4c 4c 4c 4c  4c Id  4c  4c  Id  Id  4c  4c4t  4c  4i  4c 4c  4c  4c  4c  4c  4c  4c  4i 4c  Id  4c  4c  4c  4c  4c 

IF  (U  .GE.  WEBC)  THEN 
GRL  =  0.0 
E  =  0.0 
GOTO  1140 
END  IF 
GRL  =  GL  -  U 
OD  =  D  -  U 
PRFD  =  PD  +  U 
E  =  PI*(OD**2  -  PRFD**2)/4.0 
1140  CONTINUE 

SFAREA  =  PI*(OD  +  PRFD)*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  E*GRL 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRN/VO 

RETURN 

^  4c  4c  4c  Id  4c  Id  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  d  4c  4i  4' 4c  4c  4c  4c  *  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  cd  4c  4c  4c  4c  4c  4c  4c  cd  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 
^4c4i4i4c4c*4c4c4c4c4cid4c4c4c4c4i4c4c  CODE  3'.  CORD  GRAIN  4c  id  4c  id  4c  4c  cd  4c  cd  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  id  4c  4c  cd  4c  id  id  4c  id  4c  4i 
C  4c  4c  4c  4c  4c  d  d  » Id  4c  4c  Id  4c  4c  4c  4c  4c  Id  4i  4i  4c  4c  cd  4c  4c  d  4c  *  d  *  4c  Id  4c  4i  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4i  4i  d  4c  d  4c  4c  4c  Id  4c  4c  4c  4c  Id  4c  Id  4c  4c  Id  4c  Id  4c  4c  4c  4c  4c  4 
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C***  This  part  calculates  the  conditions  before  the  grain  bums.  ****** 

1010  CONTINUE 

SO  =  GL*P1*D  +  PI*D**2/2.0 
VO  =  GL*PI*D**2/4.0 

C***  This  part  does  the  calculations  for  the  b^iming  brain. 

GRL  =  AMAXl  (GL  -  U,  0.0) 

OD  =  AMAXl  (D  -  U,  0.0) 

E  =  PI*OD**2/4.0 

SFAREA  =  PI*OD*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  GRL*PI*OD**2/4.0 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRN/VO 

RETURN 

(-I*******************  ^ODE  4:  RECTANGULAR  STRIP  GRAIN  **************** 

^4>4<***4i**i|i4iiti4i«4^*4c«*4i*4i***4'**4<***4iiti******«i*********i|<it>iK*>t<***>l‘i|i***>Kit<******* 

1020  CONTINUE 

SO  =  2.0*(GL*D  +  D*WI  +  GL*WI) 

VO  =  GL*D*WI 

GRL  =  AMAXl  (GL  -  U,  0.0) 

DS  =  AMAXl  (D  -  U,  0.0) 

WIS  =  AMAXl  (WI  -  U.  0.0) 

SFAREA  =  2.0*(GRL*DS  +  DS*WIS  +  W1S*GRL) 

FRCSFA  «  SFAREA/SO 
VOLUNB  =  GRL*DS*WIS 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

^4i4>******4<***4>***i|i********4<******i)>4>**i«i********************4<************* 

CODE  S:  SPHERICAL  GRAIN  ************************* 

1000  CONTINUE 
SO  =  PI*D**2 
VO  =  PI*D**3/6.0 
OD  =  AMAXl  (D  -  U.  0.0) 

SFAREA  =  PI*OD**2 
FRCSFA  «  SFAREA/SO 
VOLUNB  =  PI*OD**3/6.0 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

c*********************************************************************** 

C******************  CODE  6:  SLOTTED-TUBE  GRAIN  *********************** 

c*********************************************************************** 

C***  This  part  does  the  calculations  before  the  grain  bums.  ********** 

C*******************************************************************w*** 
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1040  CONTINUE 
SLOT  =  0.5*WM 

50  =  0.5*D 

51  =  0.5*PD 

THETA  =  ASDSf  (SLOT/SO) 

ALPHA  =  ASIN  (SLOT/SI) 

EO  =  (PI  -  ALPHA)*(SO**2  -  SI**2)  +  (SO  -  SI)**2*ALPHA 

SO  =  2.0''((PI  -  ALPHA)*SI  +  (PI  -  THETA)*SO  +  (SO*COS  (THETA) 

1  -  SI*COS  (ALPHA)))*GL  +  2.0*E0 

VO  =  GL*E0 

WI  =  SO  -  SI 

WEBC  =  AMINI  (GL.  WI) 


C***  This  part  does  the  calculations  for  the  burning  grain.  *********** 


IF  (U  .GE.  WEBC)  THEN 
GRL  =  0.0 


E  =  0.0 


GOTO  1150 
END  IF 


SLOT  =  0.5*(WM  +  U) 

50  =  0.5*(D  -  U) 

51  =  0.5*(PD  +  U) 

GRL  =  GL  -  U 


THETA  =  ASIN  (SLOT/SO) 

ALPHA  =  ASIN  (SLOT/SI) 

E  =  (PI  -  ALPHA)*(SO**2  -  SI**2)  +  (SO  -  SI)**2*ALPHA 
1150  CONTINUE 

SFAREA  =  2.0*((PI  -  ALPHA)*SI  +  (PI  -  THETA)*SO  +  (SO*COS  (THETA) 

1  -  SI*COS  (ALPHA)))*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  E*GRL 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRNA'O 

RETURN 


Q  *  Hi  Id  *  Id  *  i«  4i  4r  4i  4i  *  *  4>  4r  *  *  *  4i «  «  *  III  *  *  *  *  <»  *  *  <l<  KiK  *  4i  *  *  «  *  *  *  *  **  «  «  «  «  *  <1 «  «  *  4i  *  *  *  *  *  *  Hi*  *  *  null  *  *  4>  * 


(^idddidii>id*id***4.d*d4i4id4i  CODE  7:  ROUND-HEX  37-PERF  GRAIN  ***************** 

Q4idid4ididd*4i******************d*4i*idididi|ididd*4i*4i*diddd**************id4id******* 


1090  CONTINUE 
SO  =  18. 


SI  =  54. 


NPERF  =  37 

D  =  7.0*PD  +  6.0*WI  +  2.0*WO 
GOTO  1160 

Q4i4iididididdididdid*********************************>did«iid*dd**d*d**d***4i*d*****d 


^4id*id******ik*4.**4.d«4.  CODE  8:  ROUND-HEX  19-PERF  GRAIN  ***************** 

C***********»*id**********************dd******idid«iid*********************** 

1080  CONTINUE 
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so  =  12.0 

SI  =  24.0 
NPERF  =  19 

D  =  5.0*PD  +  4.0*WI  +  2.0*WO 

III  *  lit  4i  *  it>  <l<  *  «  *  *  *  *  *  4>  *  4i  41 <l>  *  4>4»l>  *  *  *  «>  4c  *  *  *  <!' It")!  >l<  >l<  *  >l>  >l<  >l"l<  4' >t<  >l<  >l<  *  *  *  >l>  4' *>•<  >l>  4>  >)' >•<  >l<  *  *  *  4>  *  *  * 
(^I|.**4c4.4.4<4>4c4t4>4i4.4<4i4<4t4i  CALCULATIONS  FOR  CODES  7,8,10  ******************** 

Q4i4ii|ii|i4i*4i4ti|i4i*4i**4i4>4i4i4i4>4>4i4t4i4>4i4t4t4>4c4i4i4i4t4c4i*4i4>4t4'4t4>4t4i4>4c4>4i4i4i4i4i4i4i4t4i4i4t4>4t4c4<4t4i4t4c4t4i4>4i 

1160  CONTINUE 
WW  =  WI  +  PD 
WW2  =  WW**2 


PRFD  =  PD  +  U 

PRFD2  =  PRFD**2 

GRL  =  AMAXl  (GL  -  U,  0.0) 

E  =  0.0 

THETA  =  2.0*ACOS  (AMINl  (WW/PRFD,  1.0)) 

ALPHA  =  ACOS  (AMINl  ((2.0*WO  +  PD  -  U)/PRFD,  1.0)) 

Dr  (U  .LT.  WO)  E  =  0.25*PI*((2.0*WO  +  PD  -  U)**2  -  PRFD2) 

IF  (THETA  .GE.  PI3)  GO  TO  1 170 

E  =  E  +  SI*0.25*(WW2*RT  -  1.5*PRFD2*(SIN  (THETA)  +  PI3  -  THETA)) 

1170  CONTINUE 

IF  (ALPHA  .GE.  0.5*(PI  -  THETA))  GO  TO  1 180 
E  =  E  +  SO*0.125*(2.0*(2.0*WO  +  PD  -  U)*(2.0* 

1  WW  -  PRFD*SIN  (ALPHA)) 

2  -  PRFD2*(SIN  (THETA)  +  PI  -  2.0* ALPHA  -  THETA)) 

1180  CONTINUE 

IF  (2.0*WO  +  PD  .LT.  WI)  THEN 
WRITE  (*,  *)  ’*FORMT*  BAD  HEX  PROP’ 

PAUSE 
GOTO  1190 
END  IF 

VOLUNB  =  E*GRL 

Q4<*4i*4i4i4i4i4i4i4i4<4>4>4>4«|i4»l>  JEST  TO  SEE  IF  GRAIN  CONSUMED  4.4.4.11.4.4.4.4.4.4.4.4.4.4.4.4.4.4.4.4. 
IF  (VOLUNB  .LE.  0.0)  THEN 
SFAREA  =  0.0 
VOLUNB  =  0.0 
GO  TO  1 190 
END  IF 

^4t4.4>4.4>4.4.4.4.4i4.4.4.*4.4.4.4.«4.4.4t4.]l^0Y^  THE  SURFACE  A]^A4.4r4.4.4.4.4.4.4.4.4.4.4.4.*4.4.4.4.4.4.4.4.4.4.4c4c 
PH  =  D/2.  -  WO  -  PD/2. 

IF  (U  .EQ.  0.0)  THEN 

SFAREA  =  2.*E  +  GRL*PH*6.  +  NPERF*PI*PD* 

1  GRL  +  PI*GRL*(2*WO  +  PD) 

GOTO  1190 
END  IF 

0***4.«*i»**4<4.4>4.*4.4c4>4.4>4.4.4.4i4.*4t]i|^Q  SLIVERING  YET**************************** 

IF  ((WO  .GT.  U)  .AND.  (WI  .GT.  U))  THEN 
SFAREA  =  2.*E  +  NPERF*(PD  +  U)*GRL*PI  +  6.*PH* 

1  GRL  +  PI*(2.*WO  +  PD  -  U)*GRL 
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GOTO  1190 
END  IF 


SLIVERING  *****♦*****************'•■********** 

SFAREA  =  2.*E 

^iit4iiiii)<«itc4i*iti*4c4iiKiic*4<ii<iic4«t<«4<*  FIRST  THE  INNER  SLIVERS  *♦******'*'************ 

IF  (THETA  .GE.  PI3)  THEN 
GO  TO  1200 
ELSE 

SFAREA  =  SFAREA  +  l.5*PRFD*GRL*(PI3  -  THETA)*SI 
END  IF 

1200  CONTINUE 

(^■x**************  NOW  THE  OUTER  SLIVERS  &  CORNERS  ****'x***************** 

CORNERS  NOT  CONSUMED  ******•********************’*'* 
IF  (WO  .GT.  U)  THEN 

SFAREA  =  SFAREA  +  PI*(PD  +  2.*WO  -  U  +  PRFD)*GRL 
END  IF 

^4i4>4i4c****4>4i*4i4i4i4i4r*«4<4<«4ii|<NQY^  OUTER  SLIVERS’*"*"*"*"*'’*''*"*"*"*"*"*''*"*"*"*"*"*"*"*''*''*"'"*"'"*'*'*’*"'' 


IF  (ALPHA  .LT.  .5*'(PI  -  THETA))  THEN 
SFAREA  =  SFAREA  +  (WW  -  PRFD’*'SIN  (ALPHA))*'GRL*'SO  + 
1  PRFD*GRL*'(PI/2.  -  ALPHA  -  THETA/2.)*'SO 
END  IF 

1190  CONTINUE 
RETURN 


(^Q[)£  9;  19.PERF  GRAIN 


C’*"*"*'  This  part  calculates  the  conditions  before  the  grain  bums  **■•■*"*"*'*• 

^  Dt  **  m  *  IK  «*«*««  4i4<**4t  *4I  *«*«*«  it>  iXKi  *4i**  4>  4>  4»l>  *  4»X  4«X  *  <X  *  IX  *  IXIX IX  X  If  *  IX  *  4>IX  it"X  <X  <t> 

1070  CONTINUE 

D  =  5.0*PD  +  2.0*'(WI  +  WM  +  WO) 

EO  =  PI*(D**'2  -  19.0'*'PD*"»2)/4.0 
SO  =  PI*(D  +  19.0'*'PD)'»GL  +  2.0'^EO 
VO  =  E0*'GL 


S19  (1,  1)  =  WI  +  P  D 
S19  (2,  1)  =  S19(1.  1) 

S19  (3.  1)  =  S19(1,  1) 

S19  (1.  2)  =  0.5*SQRT  (3.0*'(WM  +  PD)*'*2  +  (WI  +  PD)*'*2) 

S19  (2,  2)  =  S19  (1.  2) 

S19(3,  2)  =  S19(1.  1) 

S19  (1,  3)  =  PD  +  0.5*(WI  +  WM) 

S19  (2.  3)  *  S19  (1.  2) 

S19  (3.  3)  =  WM  +  PD 
S19(1.4)  »S19(1.  3) 

S19(2,  4)  =  2.0*819(1,3) 

S19  (3.  4)  =  S19  (1,  3)*RT 

WEBC  s  AMINl  (WO.  WM.  WI.  S19  (1.  3)  -  PD.  S19  (1.  2)  -  PD.  GL) 


^*iXiX*iX*iX4i«>*4i4>4>4i4i4»X4i4i4i4i4i*i****************4iiX****iX**iXiX*4i*4i*4i«i*<i*X*<i**«i«i**** 


C***  This  part  docs  the  calculations  for  the  burning  grain.  *****•*•***• 
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n  n  n  n  o  o  o 


GRL  =  AMAXl  (GL  -  U.  0.0) 

OD  =  D  -  U 

PRFD  =  PD  +  U 

IF  (G  .GE.  VtEBC)  GO  TO  1210 

E  =  0.25*PI*(OD**2  -  19.0*PRFD**2) 

SFAREA  =  PI*(OD  +  19.0*PRFD)*GRL  +  2.0*E 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  E*GRL 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRNA'O 
RETURN 
1210  CONTINUE 
SUMSA  0.0 
SUMGV  =  0.0 
DO  1220  K  =  1.  2 

CALL  GENIS  (S19  (1.  K).  PRFD.  GRL,  SA.  GV) 

SUMSA  =  SUMSA  +  6.0*SA 
SUMGV  =  SUMGV  +  6.0*GV 
1220  CONITNUE 

CALL  GENIS  (S19  (1,  3).  PRFD.  GRL.  SA.  GV) 

SUMSA  =  SUMSA  +  12.0*SA 

SUMGV  =  SUMGV  +  12.0*GV 

CALL  GENOS  (Sl9  (1.  4).  PRFD,  GRL,  .5*OD.  SA,  GV) 

SUMSA  =  SUMSA  +  12.0*SA 
SUMGV  =  SUMGV  +  12.0*GV 
SFAREA  =  SUMSA 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  SUMGV 
VOLBRN  =  VO  -  VOLUNB 
FRC'BRN  =  VOLBRN/VO 
RETURN 

(^«««***«««.**4.***«**«  CODE  10:  ROUND-HEX  7-PERF  GRAIN  ***************** 

C*** ************** ****************************************************** 

1060  CONTINUE 

50  =  6.0 

51  =  6.0 
NPERF  =  7 
GO  TO  1160 


CODE  11:  CORD  WITH  INHIBITED  ENDS  ***************** 


This  routine  will  only  calculate  the  surface  area  of  the  lateral 
surfaces. 

it  will  not  calculate  the  surface  area  of  the  inhibited  ends.  ******** 
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1100  CONTINUE 
SO  =  GL*PI*D 


VO  =  GL*PI*D**2/4.0 

C  This  part  does  the  calculations  for  the  burning  grain 
OD  =  AMAXl  (D  -  U,  0.0) 

SFAREA  =  PI*OD*GL 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  GL*PI*OD**2/4.0 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRNA'O 
RETURN 

^  it> «« III  **  III  i|i4citi  III  ))■  1)1  **  41  *111***  it<  *  4<  I**  *>•<  4>  ***  4<4>  4<  **  4>  4>  *  *****  <t<  **  <^  *********  * 

(;**********  CODE  12:  RECTANGULAR  STREP  GRAIN  WITH  INHIBITED  SIDES  ****** 

c*********************************************************************** 

C  This  routine  will  only  calculate  the  surface  area  of  the  two  burning 
C  sides. 


C  It  will  not  calculate  the  surface  area  of  the  inhibited  sides. 

c*********************************************************************** 


1110  CONTINUE 
SO  =  2.0*GL*WI 


VO  =  GL*D*WI 


VOLMAO  =  (D  -  WI)*GL*WO 
VOLMBO  =  WI*GL*WO 

c*********************************************************************** 


C  ***  This  part  does  the  calculations  for  the  burning  grain 
DS  =  AMAXl  (D  -  U,  0.0) 

SFAREA  =  2.0*GL*WI 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  GL*DS*WI 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
IF  (DS  .GE.  WI)  THEN 
VOLABR  =  VOLBRN 
VOLBBR  =  0. 

ELSE 

VOLABR  =  VOLMAO 
VOLBBR  =  VOLBRN  -  VOLABR 
END  IF 
RETURN 
END 


c********************************************************************** 

c*********************************************************************** 


c 

C  SUBROUTINE  *GENIS*:  calculate  surface  area  and  volume  for  a 
C  general  inner  sliver  of  a  burning  grain 

C  with  length  =  GRL  &  perforation  dia.  =  PRFD. 

C 


SUBROUTINE  GENIS  (S,  PRFD,  GRL,  SURF,  VOL) 
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DIMENSION  S  (3).  A  (4) 

DATA  PI2/1 .5707963/ 

C 

C 

C  ♦***•♦***•  ;  Store  angles  A1,A2,A3  and  area  of  triangle 
C  with  sides  S(1).S(2),S(3)  into  A(1)...A(4) 

C 

A  (1)  =  ACOS  ((S  (2)**2  +  S  (3)**2  -  S  (1)**2)/(2.0*S  (2)*S  (3))) 

A  (2)  =  ACOS  ((S  (1)**2  +  S  (3)**2  -  S  (2)**2)/(2.0*S  (1)*S  (3))) 

A  (3)  =  ACOS  ((S  (1)*^2  +  S  (2)**2  -  S  (3)**2)/(2.0*S  (1)*S  (2))) 

A  (4)  =  0.5*S  (1)*S  (3)*SIN  (A  (2)) 

C 

C  ...check  for  error  condition:  find  if  triangle  acceptable... 

C 

J  =  0 

DO  10001=  1,3 
IF  (A  a)  .LT.  0.5*PI2)  J  =  J  +  1 
1000  CONTINUE 

IF  (J  .GT.  1)  STOP  •  GENIS  ERROR’ 

C 

C 

C  succeeding  passes  until  burnout:  find  auxiliary  angles 
C 

TAU12  =  ACOS  (AMINl  (1.0.  S  (3)/PRFD)) 

TAU13  =  ACOS  (AMINl  (1.0.  S  (2)/PRFD)) 

TAU23  =  ACOS  (AMINl  (1.0,  S  (1)/PRFD)) 

C 

C  ...and  branch  to  25  if  sliver  fails  burnout  criteria.  If  not 
C  then  sliver  is  burned  and  go  to  30. 

C 

IF  (TAU12  +  TAU13  +  TAU23  .LT.  PI2  .AND.  GRL  .GT.  0.0)  THEN 
GO  TO  1010 
ELSE 

GO  TO  1020 
END  IF 
C 
C 

C  sliver  not  burned  out:  determine  end  area,  volume  and  surface  area 
C 

1010  CONTINUE 

E  =  A  (4)  -  0.25'^PRFD*(S  (1)*SIN  (TAU23)  +  S  (2>*SIN  (TAU13) 

1  -»•  S  (3)*SIN  (TAU12)  +  PRFD*(PI2  -  TAU12  -  TAU13  -  TAU23)) 
C 

VOL  =  E*GRL 
C 

SURF  =  2.0*E  +  GRL*PRFD*(PI2  -  TAU12  -  TAU13  -  TAU23) 

C 

C  ...and  RETURN 
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c 

RETURN 

C 

C  sliver  is  burned  out:  return  with  zero  volume  arid  surface  area. 

C 

1020  CONTINUE 
VOL  =  0.0 
SURF  =  0.0 
RETURN 
END 

Q  4t  Dcili  *  41 #  *  *  *  *  «  <>  *  *  Id  It  Hi  *  4>  ¥  Hi  4«t<  «>  i)>  *  «>  *  *  *  4>  *  *  *  *  *  *  4:  *  *  <1 «  Id  *  *  *  *  *  O  *  « Id  * 

C  SUBROUTINE  "GENOS"  :  Calculates  surface  area  and  volume  for  a 
C  general  outer  sliver  of  a  burning  grain 

C  with  length  =  GRL,  radius  =  RAD,  and 

C  perforation  diameter  =  PRFD 

C 

SUBROUTINE  GENOS  (S.  PRFD,  GRL,  RAD,  SURF.  VOL) 

DIMENSION  S  (3),  A  (4) 

C 

Q  ¥idid*4i¥¥¥*id<.¥  gjQjg  angles  A1,A2,A3  and  area  of  triangle 
C  with  sides  S(1).S(2),S(3)  into  A(l)  ...A(4) 

C 

A  (1)  =  ACOS  ((S  (2)**2  +  S  5,3)**2  -  S  (1)**2)/(2.0*S  (2)*S  (3))) 

A  (2)  =  ACOS  ((S  (1)**2  +  S  (3)**2  -  S  (2)**2)/(2.0*S  (1)*S  (3))) 

A  (3)  =  ACOS  ((S  (1)**2  +  S  (2)**2  -  S  (3)**2)/(2.0^S  (1)*S  (2))) 

A  (4)  =  0.5*S  (1)*S  (3)*SIN  (A  (2)) 

C 

c 

C  succeeding  passes  until  burnout:  determine  auxiliary  angles 
C 

TAUl  =  ACOS  (AMINl  (1..  (S  (2)**2  +  RAD**2  -  0.25* 

1  PRFD**2)/(2.*S  (2)*RAD))) 

TAU2  =  ACOS  (AMINl  (1.,  (S  (3)**2  +  RAD**2  -  0.25* 

1  PRFD^*2)/(2.*S  (3)*RAD))) 

TAU3  =  ACOS  (AMAXl  (  -  1.0,  (S  (2)**2  -  RAD**2  +  0.25* 

1  PRFD**2)/(S  (2)*PRFD))) 

TAU4  =  ACOS  (.AMAXl  (  -  1.0,  (S  (3)**2  -  RAb**2  +  0.2.5* 

1  PRFD**2)/(S  (3)*PRFD))) 

C 

SIG  ^  ACOS  (AMINl  (I.O,  S  (1)/PRFD)) 

C 

C  ...then  check  error  conditions... 

C 

IF  (TAT,J3  .LT.  A  (3)  .OR.  TAU4  .LT.  A  (2))  STOP  ’  *GENOS*  ERROR’ 

C 

C  ...IF  ok,  check  if  sliver  burned  out.  If  not  bunted  out  gc  to  25. 

C  If  burned  cut  go  to  30 
C 
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IF  (TAUl  +  TAU2  .LT.  A  (1)  .AND.  GRL  .GT.  0.0)  THEN 
GO  TO  1000 
ELSE 

GO  TO  1010 
END  IF 
C 
C 

C  sliver  not  burned  out:  detennine  end  area,  volume  and  surface  area. 

C 

1000  CONTINUE 

E  =  0.5*RAD*(S  (2)*SIN  (TAUl)  +  RAD*(A  (1)  -  TAUl  -  TAU2) 

1  +  S  (3)*SIN  (TAU2))  -  A  (4)  -  0.25*PRFD*(S  (1)*SIN  (SIG) 

2  +  0.5*PRFD*(TAU3  +  TAU4  -  2.0*SIG  -  A  (2)  -  A  (3))) 

C 

VOL  =  E*GRL 
C 

SURF  =  2.0*E  +  GRL*(RAD*(A  (1)  -  TAUl  -  TAU2)  +  0.5*PRFD*(TAU3 
1  +  TAU4  -  2.0*SIG  -  A  (2)  -  A  (3))) 

C 

C  ...and  RETURN. 

C 

RETURN 

C 

C  sliver  is  burned  out:  return  with  zero  volume  and  surface  area. 

C 

1010  CONTINUE 
VOL  =  0.0 
SURF  =  0.0 
RETURN 
EM? 

^  4>  it<  Dc  4>  *««***  «iti  *  4<  *  DC*  *  4i4i  4c  *  O***  Id*  *»>  *******  4«l>  4«t>  %  * 


^4c4c4<*4c4c4c4c4i4c4c4i4c4c4c4c4c4c4c*4t§ygj^QUYINE  COMMASS******************************** 

Q  4c  4c  4c  4c  4c  4c  4c  4i  4i  4c  4c  4c  4c  4«t<  *  4c  4c  4c  4i  4i  4c  4i  4i  d  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4i  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4i  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c 


SUBROUTINE  COMMASS 

^  4c  4c  4>  4c  4c  4c  4c  4c  cd  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


C  Version  3.0,  January  1992 
C 

C  THIS  SUBROUTINE  WILL  COMPUTE  THE  INITIAL  MASS  PER  LAYER  AS  WELL  AS 
C  THE  INTEGRALS  OF  EACH  PROPERTY 
C 


Q  4c  4c  4c  4c  4c  Id  41 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4' 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


COMMON  A3  (100),  P  (11,  15.  5) 
IGTYPE  =  INT  (A3  (45)  +  .5) 

NL  =  INT  (A3  (4)  +  .5) 

IGQR  =  INT  (A3  (31)  +  .5) 


Q  4c  4c  4c  *  4c  4c  4i  4c  4c  4c  4c  4i  4c  4c  *  4c  4c  4c  4c  4c  4i  4<  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


(^4c4c4c4c4c*4c4.4c4c4c4c4c4c4cidcd  STORAGE  LOCATION  FOR  INTEGRAL  ARE  ZEROED  4c4.4c*4c*4c4c4c*4c4c 

Q  4c  4c  4c  4i  4c  *  4c  *  4c  4c  4c  4i  Ijc  4c  4c  4c  4c  4c  4c  4c  4c  *41 4c  4c  4>  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 
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DO  10001  =  2.  11 
DO  10001=  1.  15 
P  a,  J,  3)  =  0.0 
1000  CONTINUE 

IF  OGQR  .EQ.  1)  THEN 
XI  =  0.0 


CALL  FORMT  OGTYPE,  ASURF,  VOLUNB,  XI) 
P  (8.  1,  3)  =  VOLUNB 
DO  10101  =  2,  11 


Pa.  1.3)  =  pa.  1.  i)*p(8. 1.3) 

1010  CONTINUE 

A3  (3)  =  P  (4.  1.  3) 

RETURN 
END  IF 

DO  10201=  l.NL 

Q********lHl**lHil^******************************************************** 


Q*****************  DETERMINE  X  VALUES  FOR  INTEGRATION  ****************** 


IF  (1  .EQ.  NL)  THEN 
XS  =  P  (1. 1,  1) 

XL  =  A3  (1) 

ELSE 


XS  =  P(1,1,  1) 

XL  =  P  (1,1  +  1.  1) 

END  IF 

^  Ik**  4>  it>  4< «  4<  *  i4<  4«t<  **  4<  4<  *  4<  **  O' **  O' Hilt.  **  4>  *41 K***  4i**>K*  4r  *  4.  *******  K.  **  Hi  **  * 

^**«*******************  /^WAYS  300  SUBDIVISIONS  4i*************4.********* 
^*********************************************************************** 
XDEL  =  XL  -  XS 
XSrEP  =  XDEL/300. 

DO  10301=  1,  301 
XI  =  XS  +  (I  -  1)*XSTEP 

^*********************************************************************** 
CALL  FORMT  (IGTYPE,  ASURF,  VOLUNB,  XI) 
^*********************************************************************** 

DO  1040  K  =  2,  11 
PDEL  =  P  (K.  1.  2)  -  P  (K.  1,  1) 

^*********************************************************************** 
^**********************  integration  is  PERFORMED  4<4>4<******************** 
^*********************************************************************** 


FCN  =  (a*DEL/XDEL)*(XI  -  XS)  +  P  OC.  1,  1))* ASURF 
IF  ((I  .EQ.  1)  .OR.  (I  EQ.  301))  THEN 
P  (K,  1,  3)  =  P  (K,  1,  3)  +  FCN 
ELSE 

P  (K,  1,  3)  =  P  (K,  1,  3)  +  2.*FCN 
END  IF 

1040  CONTINUE 
1030  CONTINUE 
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DO  1050  K  =  2,  11 
P  (K.  J,  3)  =  P  (K,  J,  3)*(XDEL/600.) 

1050  CONTINUE 
1020  CONTINUE 

Q  *  *  *41  *  !)■ «  4> «  41  *  «  «  Hiitiili  Kiili  I|| «  *  41 4i «  *  «  m  Kiiti «  «t  4. «  «■  *  **  «  *  *  *  III  *  «  *  «  4>  4c  Ik  «  *  Ik  **  *  «  4<  *  4<  *  *  *  *  m  *  4<  * 

(;<4c>kik4cik4c*4c**4c<|i*ikik*4i4c4i4c*4:  MASS  OF  SINGLE  GRAIN*************'''************* 
Q  4i «  *  Ik  4i  4i  4i  4i  4<  4>  4i  *  4i  *  4i  4i  4i  4c  4>  4>  4i  4<  *  <k  4>  4c  4c  4i  4i  Ik  4>  4c  4iik  4i  4i  4<  4c  4c  4>  4i  4i  Ik  <k  4i  4c  4<  4c  >k  4i  4>  4>  Ik  4i  4i  4i  4c «  4>  4<  4<  4c  4<  4i  4i  4i  4i  4i  4i  4c 

DO  10601  =  1,NL 
A3  (3)  =  A3  (3)  +  P  (4. 1.  3) 

1060  CONTINUE 
RETURN 
END 

Q4c4c4c4c4c4c4c4i4c4c4c4c4i4c4c4c4c*ik4c4i4c4c4c4c4c4c4c4c4c4c4c4c4c*4c4c4c4i4c4c4>4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c*4i4i4c4c4c4i4i4c4i 
Q4cik4c4c4i4i4i*ik4i4i4c4c4c4i4i4i4c*4i4c4i  SUBROUTINE  PRINTP****************************** 
^4c4c4i*4c4i4i4i*ik4c4i4i4i4i4c4c4i*ik4i4c44c*4i4i4i*ik4c4c4c4c4>4c4c4c4i**4c4c4c4c4>4c4c4c4c4c4c4<4c4c4c4c4c4c4c4c4>4c4c4c4c4c4c4c4c4c 

SUBROUTINE  PRINTP  (Al) 

CHARACTER*20  Al  (20) 

COMMON  A3  (100).  P  (11.  15.  5) 

Q4c*4c*4i*4c4c4c4i4ck**4c4ik4c»4i4i*4ik4i*4i4c*4c44c**4c*4c4c4c4c4i4i4c4c4c*44c4c4c4c4c4>4c4c4c4c4cik4c4c4c4c4c4c4ck4cikik4c 

NL  =  INT  (A3  (4)  +  .5) 

OPEN  (UNIT  =  7.  FILE  *  ’LPTr) 

WRITE  (7.  6000)  Al  (3) 

6000  FORMAT(10X.’MASTER  FILE;  ',A20Jf) 

WRITE  (7.  6010) 

6010  FORMAT(/.30X,’BEG  LAY  END  LAY  INTEGRAL’) 

DO  1000  Is  1.  11 
WRITE  (7.  6020)  I 

6020  FORMAT(//.30X.’PROPERTY  NUMBER:  M3) 

DO  1010  J=  l.NL 

WRITE  (7.  6030)  J.  P  0.  J,  1).  P  (I.  J.  2).  P  (I.  J,  3) 

6030  FORMATC  ’,I3,15x.3F20.10) 

1010  CONTINUE 
1000  CONTINUE 
RETURN 
END 
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iNTENmONALLY  LEFT  BLANK. 
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PROGRAM  MKGAGE 

^  itriti  Hi  4' *  41 *  *  *  *  *  *  *  *  »  4«ti «  *  *  *  4i  %  «  *  *  4>  *  **  *  *  *  O  *  *  «  «  *  *  *  *  *  « Bn*  *  «  *  O  *  *  ^  «  *  *  *  *  *  » >»  «  4c  * 

C  Version:  3.0,  January  1992 
C 

C  Wntten  by:  William  Oberle,  U.S.  Amy  Research  Laboratory 
C 

C  Purpose:This  program  maintams  a  data  base  for  gages  used 
C  in  tire  BRLCB  data  reduction  program.  The  data 
C  file  is  GAGEFILE  and  should  be  on  the  same  drive 
C  as  the  program. 

^4c4i4c4>4i4>4i4i<l>4<4c4i4i4c*4c4i4>4i4c4i4i4i«4c4i4>4i4c4i4c4c4c4i4i4c4<4c4>4'4t4>4i!i>4>4>4>4<*4<4>4<4<4>4c4>4i4<4<4>4>4i4i 


CHARACTER  AG  (100)*6,  BG  (100)*9.  XGAGE*6.  YGAGE*6.  XTEMP*1 
DIMENSION  CG  (100,  3) 


^4»(<4'4<4i4‘*4>4i4i*4c*4i4c4c4c4’4c4c4i4c4i*4i4i4c4<4c4c4c4c4c4c4c4c*4c4c4c4i4t4c4c4c4c4c4c4c4c4c4i4c4>4c4>4>4>4c4i4c4c4c4c4<4c4c4i4c4c* 
^4<4>4>4c<)'4c4c4c4i4c*4c  CLEARING  ARRAYS 

^4i4i*4c*4<4<4>>t<4<4i4c4i4t4i4>4<4<4>4>4c4<4i4c4<4>4i4c4i4c4>4c4>4i4>4c4i4i4c4c4c4>4t4>4>4>4>4<*4i4<4c4c4>4>4<4>4>4c4c4<4<4>4c4<*4<4c4i4c4i 


DO  10001  =  1.  100 
AG  0)  =  ’ 

BG  (I)  =  * 

CG  (1.  1)  =  0.0 
CG  (I.  2)  =  0.0 
CG  (I.  3)  =  0.0 
1000  CONTINUE 

^4>4<4»t<*4<4<4i*4i*«»4<4<4<4«04c4i4<4<****4<4i**>|c4i4c4c4c4i*4c*4c4i4>4c4c4c4i4c4><t<*4>«*>l>4i4c4c4<4c4>4>4t4>4c4c4i4c4c4c4c4c 

C  The  gage  data  file  is  read. 

^  4c  4>  4i  4>  4i  4c  4i  4i  4i  4i  4i  4<  *  4c  4i  *  4i  *  4>  *  4>  *  4>  *  *  4c  4>  4c  4<  4>  4c  4c  4<  4>  <•  4c  *  *  *  *  4>  4>  4>  i|<  41 4>  W  4’ 4i  4i  4i  4c  *  4c  4>  4c  4c  4c  4c  41 4i  41 4<  4c  4c  4i  4i  4i  4i  4i 

CALL  READER  (ITN.  AG.  BG,  CG) 

Q4c  4c  4c  4c  4c  4c  c»  c4  cf  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  <4  4c  4c  ck  c4  c»  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  * 

C  The  number  of  pages  is  detemined. 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4' 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4<  4c  4c  4c 


1010  CONTINUE 

IF  ((ITN  .GE.  1)  .AND.  qTN  .LE.  20))  NPAGE  =  1 
IF  (GTN  .GE.  21)  .AND.  (ITN  .LE.  40))  NPAGE  =  2 

IF  ((ITN  .GE.  41)  .AND.  (ITN  .LE.  60))  NPAGE  =  3 

IF  ((ITN  GE.  61)  .AND.  (ITN  .LE.  80))  NPAGE  =  4 

IF  ((ITN  .GE.  81)  .AND.  (ITN  .LE.  100))  NPAGE  =  5 

Q  4c  4c  4c  4c  4c  ck  4c  ck  ck  ck  4c  4c  4c  ck  4c  4  ck  4c  4c  ck  4c  ck  ck  ck  4c  ck  ck  4c  4c  ck  ck  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  ck  ck  ck  4c  ck  4c  4c  4c  4c  4c  4c 

C  The  gage  sub-menu  is  presented. 

^  Ck  4c  Ck  Ck  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  Ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

1020  CONTINUE 
CALL  CLEAR 
WRHE  (*,  6000) 

6000  FORMATC  ’,T30,’Gage  Maintenance  Program’) 

WRITE  (*,  6010) 
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6010  FORMATC  ’,T38,’Sub  Menu’) 
WRITE  (*.  •) 


WRITE  (*,  *) 
WRITE  (*,  *) 
WRITE  (*,  *) 
WRITE  (*,  *) 
WRITE  (* 
WRITE  (* 
WRITE  (• 
WRITE  (* 


*) 

*) 

*) 

*) 


1.  View  gage  information.’ 

2.  Add  a  gage  to  data  base.’ 

3.  Delete  a  gage  from  data  base.’ 

4.  Locate  specific  gage  in  data  base.’ 

5.  Exit.’ 


Please  Enter  Your  Choice  (1-5):  ’ 

READ  (*.  *)  ICHOICE 
IF  OCHOICE  .GT.  5)  THEN 
WRITE  (*.  *) 

WRITE  (*,  *)  ’The  choice  you  have  made  is  not  between’ 

WRITE  (*,  •)  *1  and  5.  Please  select  again.’ 

GO  TO  1020 
END  IF 

Q  *  Hull  *  Id  *  «  *  *  Hi  4c  Id  4c  4<  it<  4>  IK  *  *  « IK  *  4i  4I  *  *  *  *  *  «  *  *  *  4i  *  i*  *  4»t>  4t  4<  4<  4>  <f  *  It«l>  «*  «  *  *  *  4>  4>  *  *  *  *  *  *  Di  * 

C  The  proper  action  is  taken  depending  on  the  selection. 

Q  4i  4c  4i  4i  4i  4i  4i  4>  Id  4i  4i  Id  Id  4i  4c  4<  4i  4c  4i  4<  4<  4c  4c  4c  41 4i  4i  4<  41 4i  4i  4<  4c  4c  4i  4c  4i  4c  4i  4141 4>  4i  4>  4c  4<  4>  4>  4>  4c  4>  Id  4>  4c  4i  4>  4<  4c  4c  4>  4<  Id  4c  4i  4i  4c  4c  4i  4c  4c  Id 


IF  (ICHOICE  .EQ.  5)  GO  TO  1030 
IF  OCHOICE  .EQ.  1)  THEN 

^  Id  Id  4i  Id  4>  4c  4i  4c  4c  Id  4c  4c  4c  4c  4i  4i  4i  *  4c  4c  *  Id  41 4c  4i  4c  *  4c  4c  4c  4i  Id  Id  4c « Id  4c  4c  Id  4c4c  41 4c  Id  4c  4c  4c  4i  Id  4c  4c  41 4c  4c  Id  41 4c  Id  Id  4c  Id  Id  4c  *  4c  Id  Id  Id  Id  4c  Id 


IF  (ITN  .EQ.  0)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’No  gages  are  in  the  gage  file.* 

WRITE  (*,  *)  ’Enter  another  option.’ 

WRITE  (*,  •) 

PAUSE 
GO  TO  1020 
END  IF 
CALL  CLEAR 
WRITE  (*,  *) 

1040  CONTINUE 

WRITE  (*,  6020)  ITN 

6020  FORMAT(’  ’, ’There  are  ’,13,’  entries  in  the  gage  data  file,’) 
WRITE  (*,  6030)  NPAGE 

6030  FORMAT(’  ’,’This  information  is  displayed  in’,I3.’  screen  pages.’) 
WRITE  (*,  6040) 

6040  FOI^AT(’  ’, ’Which  page  would  you  like  to  view?  ’) 

READ  (*,  *)  IPAGE 
IF  (IPAGE  .GT.  NPAGE)  THEN 
WRITE  (•,  *) 

WRITE  (*,  *)  ’The  choice  you  have  made  is  not  in’ 

WRITE  (•,  •)  ’the  proper  range.  Please  select  again.’ 

GO  TO  1040 
END  IF 

CALL  HEADER 
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CALL  PAGER  (ITN,  IPAGE,  AG,  BG.  CG) 

GO  TO  1010 

^  *  4< «  *  «  «  *  *  «  4> «  *  *  «  *  «  4> «  *  4>  *  «  4t  *  4>  *  *  *  4r  *  «  4>  4c «  « i«> «  «  *  *  *  i|»K  *  *  %  m  « Id  *  *  4<  *  41 4>  4< «  4< 

C  The  end  of  option  1. 

^4i  4i  4r  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  4>  4c  4c  4i  4<  4<  4>  4<  4>  4>  4i  4<  4i  4i  Id  4>  4>  4: 4<  4>  4i  4>  4i  4<  4<  4c  4<  cd  4<  4i  4c  4<  4i  4>  4i  4c  4c  4c  4<  4i  4<  4c  4<  4<  4>  Id  4c  4>  4i  4i 

ENDEF 

^  4c  4c  4c  *  4c  4c  4<  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c 

C  Option  2 

^4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  id4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c*idid4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c*4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  Id  4c 

IF  aCHOICE  .EQ.  2)  THEN 
CALL  GAGEADD  OTN.  AG,  BG,  CG) 

GO  TO  1010 
END  IF 

^4i  4cid  4c  4c  4c  4c  Id  Id  4c  4c  4c  4c  4<  Id  4c  4c  4c  4c  Id  4c  4c  4c  4cd4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c*4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c 

C  Option  3 

^4c  4c  4c  **  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4- tc  4c  4c  4c  Id  4c  4c  d  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  * 

IF  aCHOICE  .EQ.  3)  THEN 
CALL  DROPPER  (ITN,  AG,  BG,  CG) 

GO  TO  1010 
END  IF 

^  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  d  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4>  4c  4i  4c  4c  4c  4>  4c  4c  d  41 4c  4c  4c  4c  4c  4c  4c  4c  4c  d  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c 

C  Option  4 

^ddd4cddddddd4cd4cdddd4cdidddddddddddddddddddddddddd4cdddddddddddddddddddddddd 

IF  aCHOICE  EQ.  4)  THEN 

^4cddddd4id4cdd4cd4cddddddddddiddddddddddddddddddddddddddddddddddddddddddddddd 

C  A  scteen  c’earing  routine  should  be  inserted  at  this  point 

^idddddddd4c4cddddddddddddddddddddddddd4cddddddddddddddddddddddddddddddddddd 

CALL  CLEAR 
CONTINUE 

WRITE  (*,  *)  ’Enter  the  I.D.  number  of  the  desired  gage.  ’ 

WRITE  (*,  ♦)  ’Enter  all  letters  as  capital  letters.’ 

READ  (*.  5000)  XGAGE 
FORMAT(A6) 

CONTINUE 
YGAGE  =  • 

IF  (XGAGE  .EQ.  ’  ’)  GO  TO  1050 

^4cdd4cdddd4cdddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd 

C  Test  is  determine  if  xgage  starts  with  a  blank 

^iddd4cdd4cdddddd4cd4cddddddddddddddddddddddddddddddddddddddddddddddddddddddd 

IF  (XGAGE  (1:1)  .EQ.  ’  ’)  THEN 
DO  1070  II  =  2.  6 

YGAGE  (II  -  1;II  -  1)  *  XGAGE  (1:1) 

1070  CONTINUE 

XGAGE  =  YGAGE 
GO  TO  1060 
END  IF 

^4cd4cdddddddd4cd4cddddddddddd4iddddddd4>ddddddddddddddddddddddddddddddddddddd 

C  Now  the  search  begins. 


1050 


5000 

1060 
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^  *  41 4t »  He  *  «  *  *  i|>  *  *  «  *  *  *  *  *  *  *  *  *  *  *  4c  4<  *  *  Ik  *  4<  *  *  *  *  4c « <!•  !)•  4>  %  <t<  >l<  >t<  <i<  >)<  4c  it>  III  %  4i  :)>  Ik  4> «  4>  *  s|i  1)1 4>  *  «  « it< 


DO  10801=  1,  ITN 
IF  (XGAGE  .EQ.  AG  0))  THEN 
WRITE  (*,  *)  ’A  match  has  been  found.’ 

WRITE  (*,  *) 

WRITE  (*,  *) 

PAUSE 

CALL  HEADER 

WRITE  (•.  6050)  I.  AG  a).  BG  0).  CG  (I,  1),  CG  H.  2),  CG  (I,  3) 
6050  FORMATC  ’,I3.2X.A6.2X.A9,3X,E12.5,6XE12.5,6XE12.5) 

WRITE  (*,  *) 

WRITE  (*,  *)  'Press  Enter  to  Continue.  ’ 

READ  (*.  5010)  XTEMP 
5010  FORMAT(Al) 

GO  TO  1010 
END  IF 

1080  CONTINUE 


WRITE  (*,  ♦)  ’The  gage  is  not  in  the  table.’ 
WRITE  (*,  ♦)  ’Press  Enter  to  Continue.  ’ 
READ  (*.  5010)  XTEMP 
GO  TO  1010 


^  Ik  4c  Ik  Ik  Ik  4c  Ik  4c  Ik  4c  Ik  4i  4c  4c  4c  Ik  4i  4c  Ik  4c  4c  4c  4c  4c  4c  4i  4c  4i  4c  4i  «i  4i  4i  4c  Ik  4i  Ik  Ik  4c  4c  Ik  Ik  4i  4c  Ik  4c  Ik  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4i  Ik  4i  4i  4i  4i  4i  4c  4c  4c  4c  4c  4c  4c 


C  This  is  the  end  of  option  4. 

^  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4- 4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4  4c  4c  4<  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i 


END  IF 

^  4c  4c  4i  4c  4c  4c  4c  4  4c  4c  4i  4c  4c  4c  4c  Ik  4c  *  4  4c  4c  Ik  *  4c  4c  4c  4- 4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  Ik  4c 

C  To  exit  the  program  the  gage  file  is  written. 

^  4i  4c  4i  4i  4i  4c  4i  4i  4c  4i  4i  4c  4c  4c  4i  4c  4i  4c  4c  4c  *  *  *  4c  4i  4c  4i  4c  4c  4c  4i  4i  4c  4c  4i  4c  4i  4i  4c  4i  *  4i  4c  4i  4c  4c  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  4i  *  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4i  4c  4 

1030  CONTINUE 

OPEN  (UNIT  =  8,  FILE  =  ’GAGEHLE’) 

WRITE  (8,  *)  ITN 
DO  10901  =  l.ITN 

WRITE  (8,  6060)  AG  (1).  BG  (1).  CG  (I,  1),  CG  (I.  2).  CG  (I.  3) 

1090  CONTINUE 

6060  F0RMAT(A6.A9,3E12.5) 

CLOSE  (UNIT  =  8) 

STOP 

END 

^  4c  Ik  *  4c  4c  4c  4c  Ik  4c  4c  4c  4i  4c  Ik  4c  4i  4c  4c  4c  4c  4c  4c  4c  4i  4  4c  4i  4i  4c  4i  4c  4i  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  Ik  4c  4  4c  4c  4c  4i  4i  4c  4>  4c 

SUBROUTINE  HEADER 

^Ik4c4ik4cik4c4c4c4i4iik4c4c4c4c44c4i4i4c4i4i4c4c4c4i4c4'4c44c4c4c*4cik4c4i4c4c4c4i4c4c4c4c4c4c4c4c4c4c4c4c4c4i4c4c4c4c4*4c4c4c4c4c4c4i4c 

CALL  CLEAR 

WRITE  (*.  *)  ’  The  data  fit  is  of  the  form;  A  +  Bx  +  Cx''2’ 

WRITE  (*.  6000) 

6000  FORMATC  #’.4X,’I.D.',3X,’Cal.  Datc’.8X.’A’,18X.’B’,18X,’C’) 

WRITE  (•.  6010) 

6010  FORMATC  ’.80(’-’)) 

REFURN 
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END 

SUBROUTINE  PAGER  (ITN.  IPAGE.  AG.  BG.  CG) 

. . . 

CHARACTER  AG  (100)*6.  BG  (100)*9 
DIMENSION  CG  (100,  3) 

. . . 

C  Test  to  see  if  there  are  entries  on  the  chosen  page. 

Q*  ********  *•«>*****  *4i******«i»»*4i«4i4i**4>  «>*«<•  4>4i*4i**4t4<«^4i4i*4i**«««*4i4i*4i*4i4i«>«i»* 

1000  CONTINUE 

IX  =  20*(1PAGE  -  1) 

DF  (IX  .LT.  ITN)  GO  TO  1010 

WRITE  (*.  *)  ’There  arc  no  entries  on  the  page  selected.’ 

1020  CONTINUE 

WRITE  (*.  •)  ’Please  enter  a  new  desired  page  number.  ’ 

PvEAD  (•  *)  IPAGE 
CALL  HEADER 
GO  TO  1000 
1010  CONTINUE 

ISTART  =  20*(IPAGE  -  1)  +  1 
lEND  =  MINO  (20*IPAGE.  ITN) 

DO  1030  I  =  ISTART.  lEND 

W'RITE  (*.  6000)  I.  AG  (I).  BG  (I).  CG  (I.  1).  CG  (1.  2).  CG  (I.  3) 

1030  CONTINUE 

6000  FORMAT!’  ’.I3.2X.A6.2X.A9.3X.E12.5.6X£12.5.6X j- 12.5) 

1040  CONTINUE 

WRITE  {•.  *)  ’New  page  (1)  or  options  (2)'!  ’ 

READ  {•.  •)  lOPT 
IF  (lOPT  GT  2)  THEN 
WRITE  C.  •) 

WRITE  (*,  *)  ’The  choice  you  have  made  is  not  a’ 

WRITE  (•.  •)  ’1  or  2.  Plca.se  select  again.’ 

GO  TO  1040 
END  IF 

IFMOPT  EQ  DGOTO  1020 

RETURN 

END 

. . . . ********** . ********** . ******************** 

SUBROUTINE  READER  (ITN.  AG.  BG.  CG) 

. . ********************************* 

CHARACTER  AG  (100)*6.  BG  (100)*9 
DIMENSION  CG  (100.  3) 

OPEN  (UNn  =  7.  FILE  =  GAGERLE  ) 

REWIND  7 

. . ******************************************* 

C  The  gage  Hie  is  opened  and  read 

(;*******•***********•*************************************************** 

READ  (7.  *)  ITN 
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IF  (ITN  .EQ.  0)  THEN 
WRITE  (*,  *)  ’The  gage  file  is  empty/ 

CLOSE  (UNIT  =  7) 

RETURN 
END  IF 

DO  1000  I  =  1,  ITN 

READ  (7.  5000)  AG  G).  BG  (I).  CG  (I.  1).  CG  (I.  2).  CG  (I.  3) 

1000  CONTINUE 

5000  FORMAT(A6.A9.3E12.5) 

CLOSE  (UNIT  =  7) 

RETURN 

END 

SUBROUTINE  GAGEADD  OTN,  AG.  BG,  CG) 

CHARACTER  AG  (100)*'6.  BG  (100)*9.  XGAGE*6,  YGAGE*6 
DIMENSION  CG  (100,  3) 

ITN  =  ITN  +  1 
IF  (ITN  .GT.  100)  THEN 
WRITE  (*,  *)  ’No  room  left  in  the  gage  data  file.’ 

WRITE  (*.  *)  ’Return  to  menu  and  delete  unwanted  gages.’ 

RETURN 
END  IF 
CALL  CLEAR 
1000  CONTINUE 

WRITE  (*,  *)  ’  Please  enter  the  gage  ID.  ’ 

WRITE  (*,  •)  ’  Enter  all  letters  as  capital  letters.’ 

READ  (*,  5000)  XGAGE 
5000  FORMAT(A6) 

1010  CONTINUE 
YGAGE  =  ’ 

IF  (XGAGE  .EQ.  ’  ’)  GO  TO  1000 

^*********************************************************************** 
C  Test  is  determine  if  xgage  starts  with  a  blank 

0*******************************************************4  *************** 

IF  (XGAGE  (1:1)  .EQ.  ’  ’)  THEN 
DO  1020  II  =  2,  6 

YGAGE  (II  -  1:11  -  1)  =  XGAGE  (1:1) 

1020  CONTINUE 

XGAGE  =  YGAGE 
GO  TO  1010 
END  IF 

AG  GTN)  =  XGAGE 

WRITE  (*,  *)  ’Enter  the  date  of  gage  calibration  (mm/dd/yy).  ’ 

READ  (•.  5010)  BG  (ITN) 

5010  FORMAT(A9) 

WRITE  (*,  *)  ’Calibration  constants  must  produce  pressure  in  MPa’ 

WRITE  (*,  •)  ’The  form  of  the  data  fit  is:  P(MPa)=  A  +  Bx  +  Cx''2’ 
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\^'RITE  (*,  *)  ’Enter  the  value  for  A;  ’ 

RliAD  (*,  •)  CG  OTN.  1) 

WRITE  (*,  *)  ’Enter  the  value  for  B:  ’ 

READ  (*,  *)  CG  GTN.  2) 

WRITE  (*.  *)  ’Enter  the  value  for  C:  ’ 

READ  (*,  *)  CG  OTN,  3) 

^  Id  *  «  *  «  4II|| «  *  *  *  *  *  Id  4>  •  *  *  *  «  *  *  **  *  *  Hi  41*  4>  Hi*  *  *  *  *  *  *  *  *  « iX  *  Di  4>  K  lO  «  *  *  4>  Hi  I|<  *  4>  4<  DC*  *  *  *  *  *  «  4i  *  *  «  * 

C  Now  a  search  is  performed  to  determine  if  the  new  entry  supercedes 

C  a  earlier  data  set. 

^■d  4>iti4i*4<***4i**i|>**4ii|>4i*4i*4i*****4«i4i  4i  41****41**41*111 4i4<id4i4>  id^^iliAditiitiitiidid  Id  ■t»d4<4<*4i*4i*i|<  Id  4< 

DO  1030  I  =  1,  ITN  -  1 
IF  (XGAGE  .EQ.  AG  0))  THEN 
WRITE  C^.  *)  ’The  gage  added  to  the  data  base  was  already  in’ 
WRITE(*,*)’the  data  base.  The  earlier  entry  will  be  tagged’ 

WRITE  (*,  *)  ’with  a  as  the  last  character  of  the  I.D.  field.’ 

XGAGE  (6:6)  =  ’*’ 

AG  (I)  =  XGAGE 
WRITE  (*.  *) 

PAUSE 
END  IF 

1030  CONTINUE 
RETURN 
END 

(^*************************id****id  Id***********  ******  ********  ************** 


SUBROUTINE  DROPPER  (ITN,  AG,  BG.  CG) 


^****id4i4l***«**********id****4i4i******idid*********************************** 


CHARACTER  AG  (100)*6.  BG  (100)*9 
DIMENSION  CG  (100,  3) 

CALL  CLEAR 


WRITE  (*,  *)  ’Enter  the  number  for  the  line  in  the  gage  data  file’ 
WRITE  (*,  ♦)  to  be  deleted.  This  is  not  the  gage  I.D.  ’ 

READ  (*,  *)  IDEL 


Qv********************************************************************** 


C  Shifting  the  entries  in  the  table. 

^*********************41 41 41**41 41 4i*d4i  41 41**********************  *************** 


DO  1000  I  =  IDEL  +  1,  ITN 
AG  (I  -  1)  =  AG  a) 

BG  (I  -  1)  =  BG  0) 

CG  (I  -  1,  1)  =  CG  (I.  1) 
CG  (I  -  1,  2)  =  CX3  (I,  2) 
CG  (I  -  1,  3)  =  CG  (I.  3) 
1000  CONTINUE 
ITN  =  ITN  -  1 


RETURN 
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END 

Q 4i « <1  * 4i Wi * i|< * 4t 4c 4i i|< 4< «•  4i4< 4< « 4<4i 41 4< 4' <•  >l< <>* 't' **«*■  ***4' 4<  ^ 

SUBROUTINE  CLEAR 

^  4>  4i  4<  4i  4i  4i  4i  4c  *  c|i  *  lii  4c  4>  i(<  4«t' <••  c4  >4  4c  4' 4>  O' <•  4>  *  *  4<  4c  4>  4<  i*>  41  «<  4^  4i  4<  <•■  <•  i(<  ■*<  4i  *  i|<  4<  ct<  4<  4i  4>  CS  4<  4  cr  >1>  4<  4<  *  4i  4c  4c  4' 4>  *  <l<  <•<  4> «  4< 


CHARACTER  ST*4 
DATA  ST/’  f2J’/ 
^TUTE  (*.  6000)  ST 
600C  i'ORMAT  (IX, A4) 
RETURN 


ENT> 
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APPENDIX  H: 

LISTING  -  PROGRAM  MKPTDATA.FOR 
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iNTEmiONALLY  LEFT  BLANK. 
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nnnonoonn 


PROGRAM  PTDATA 

^  4nt<  *  4>  Id  4i4i«  4iiti  4i**  4i  Hiili  4ri|ci|<  4i «  O  4i4<  4ii|i  **  4>  *  ******  4«t<  it<  *  4<4<«  4<  4i  ***  4«4<  «>  4>  4<  *  4>  ********  il>  * 

Version:  3.0,  JANUARY  1991 


Last  Revision:  2/8/92;  cleanup 

Written  by:  William  Oberie,  U.S.  Army  Research  Laboratory 


Purpose:  The  purpose  of  this  program  is  to  prepare  the  pressure 
time  data  for  use  in  BRLCB.  This  assumes  that  the  PA 


or  VA  data  has  been  obtained  elsewhere. 
^*********************************************************************** 


CHARACTER  CH*1 
1000  CONTINUE 
CALL  CLEAR 
WRITE  (*.  6000) 

6000  FORMATC/////) 

WRITE  (*,  6010) 

6010  FORMAT(10X, ’BRLCB  supports  five  options  for  preparing’, 
l/,10X,’the  pressure-time  data  for  the  computation’, 

2//,15X,’l.  ASCII  file  of  time  &  pressure.  2  col,  time/pressure’, 
3/,15X,’2.  ASCII  file  of  pressure,  1  col.  pressure’, 

4/,15X,’3.  ASCII  file  of  time  &  voltage,  2  col,  time/voltage’, 
5/,15X,’4.  ASCII  file  of  voltage,  1  col,  voltage’, 

6/,15X,’5.  A  voltage-time  file  from  VuPoinb'BRL  Procedure.’, 
7/.15X.’6.  Exit  Option.’y/. 

810X,’How  will  the  pressure-time  data  be  entered?’, 

9/,10X, ’Enter  your  choice.  (1-5  or  6  to  EXTT)'J/) 

READ  (*.  5000)  ICHO 
5000  FORMATa2) 

IF  aCHO  .EQ.  1)  THEN 
CALL  ASCII 

ELSE  IF  (ICHO  .EQ.  2)  THEN 
CALL  BSCII 

ELSE  IF  (ICHO  .EQ.  3)  THEN 
CALL  CSCII 

ELSE  IF  (ICHO  .EQ.  4)  THEN 
CALL  DSCII 

ELSE  IF  (ICHO  .EQ.  5)  THEN 
CALL  VU 

ELSE  IF  (ICHO  .EQ.  6)  THEN 
GO  TO  1010 
ELSE 

WRITE  (*,  *)  ’WARNING!!  Your  selection  is  not  between  1  &  6.’ 
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WRITE  (*.  *)  Try  Again/ 

PAUSE 
GO  TO  1000 
END  IF 

C  Provisions  to  convert  an  additional  file  included 
CH  =  ’Y’ 

CALL  CLEAR 
WRITE  (♦,  6020) 

6020  FORMAT(////,10X,’Do  you  wish  to  prepare  an  additional  pressure’, 
l/.lOX.’time  file  for  BRLCB?  [Y/N]’) 

WRITE  (*.  6030)  CH 

6030  FORMATC  ’y//.10X, ’Enter  your  choice.  [’.Al.’]’) 

READ  (*.  5010)  CH 

5010  FORMAT(Al) 

IF  ((CH  .EQ.  ’Y’)  .OR.  (CH  .EQ.  ’y’)  .OR.  (CH  .EQ.  ’  ’))  THEN 
GO  TO  1000 
END  IF 

1010  CONTINUE 
END 

Q  *  4>  *  Ik  *  Hi  *  *  <1  *  *  *  *  **  *  *  *  4iit<  *  *  *  «> «  <1 1|< «  *  I*«f  >l<  4<  *  *  IK*  *  *  4t  *  Oc*  *  4>  If 

^Ik*ikik«4i4,ik4<«4,4c*4<ik4<**4if4c*4,ik  SUBROUTINE  ASCII  ***************************** 

QHt1r)lt**iHtnnti*1t*****************iHt***tiit)i^it)‘*tt‘itt************m****************** 

SUBROUTINE  ASQI 
DIMENSION  VT  (2050) 

CHARACTER*20  NAME.  NAMEl,  GAGE*6 
CALL  CLEAR 
WRITE  (*.  6000) 

60(X)  FORMAT(//,10X, ’Enter  the  file  name  for  the  pressure  and’, 
l/,10X,’timc  data,  include  drive  and  extension.  ’, 

2/,10X,’It  is  expected  that  the  data  will  be  in  two’, 

3/,10X,’cotumns,  time  &  pressure.  The  time  step  is’, 

4/,10X,’not  important  but  the  pressure  must  be  in’, 

5/,  1  OX, ’metric  units  of  MPa.  If  the  pressure  is  not’, 

6/,10X,’in  MPa,  it  must  first  be  converted.  A  maximum’, 

7/,10X,’of  2048  time/pressure  pairs  is  allowed.’y//) 

READ  (*,  5000)  NAME 
CALL  CLEAR 
WRITE  (*,  6010) 

6010  FORMAT(////,l OX, ’Enter  the  file  for  the  output  file  which  will’, 
l/,10X,’contain  the  pressure-time  data  ready  for  BRLCB.  ’, 

2/,10X, ’Enter  file  name,  all  DOS  path  conventions  apply,’, 

3/,10X,’but  there  can  be  no  extension  for  the  file.’, 

4/,10X,’Note:  This  file  name  will  be  the  name  used  for  all’, 

5/,10X,’other  files  produced  by  the  BRLCB  analysis.’, 

6/,10X,’This  is  the  file  name  to  use  when  asked  in  subsequent’, 

7/,  1  OX, ’options  for  a  file  name.’,//) 

READ  (*,  5000)  NAMEl 

5000  FORMAT(A20) 
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CALL  CKNAME  (NAMEl) 

CALL  CLEAR 

C*******  GAGE  INFORMATION  IS  STILL  REQUIRED  FOR  THE  FILE  *************** 

0  4> «  4i  4iiti ««  4ii|i « iK«*  Ik  *  it<  *  4>4<  4i  4i  Hull  *«  4>  4»li  ****««  He  *  it<  4i  41  ***  4>  it<  Xcikiti  IK  *  *4i  4i  ***>)<«*  4t 

GAGE  =  ’None’ 

AX  =  0.0 
BX  =  0.0 


ex  =  0.0 

VIN  =  0.0 

Q4i4i4i4i4i4i4i4i4iiK4i4i4<4i»4i4i4<4i4i4i4i4i4i4i4<iK4i«4i*4i4i4iiK4i4i»4i4iiK4i4i4i4i4i4iKiKiKiKiK4i4iiK4i4i4i4i4iiKiK4iiK4<%4<4«KiK4< 

^4i4<4i4<4i4i4i4iiK4i4i4i4i4<4i4i4«>  OUTPUT  FILE  IS  CREATED  **********************'I'X‘**»** 

^iK4i*<K<K4<*4i<K*4i<Kik4i4i*<K*4i4i4i4i4i4iiK*4<iK4i**4i4i*4i<l>4i<K*iK4»K>K*K4i**4iiK4i4i4i4'iKiK4i4i4i4<4i4i4i4iiKiK4iiK4<4i4i 
^4i4i4i4i4<4i4i4i*4i4i4i4i4>4i<K*4>  PresSUre-time  dStS  is  read  'l"*"l‘V4i4i4i4iiK4i4>4>4>4<4>4<4i4i4i4i*4i4i4>4i 
^iKiK*4'4<*4i*i^4i*4i4i»4i4i4i4i4i***iKiKiK4i4iiK4i4i4i4i4i4i4i4iiK4iiK4i4i4i4i4i*4i4iiK4<iKiKiK4i4i4i4i*4<4i**)KiKiK4«|iiKiK4<4i4< 

CALL  CLEAR 
NV=  1 


OPEN  (UNIT  =  7.  FILE  =  NAME) 
REWIND  (7) 

READ  (7.  *)  Tl.  VT(1) 

T1  =  0.0 


PMAX  =  VT  (1) 

PMIN  =  PMAX 
WRITE  (*,  6020) 

6020  FORM ATC///,1  OX, ’Enter  the  time  step  for  the  data  in  millisecs.’) 

WRITE  (•,  6030) 

6030  FORMAT(///) 

READ  (*,  *)  DTT 
DTT  =  DTT/1000. 

TMIN  =  0.0 
1000  CONTINUE 

READ  (7.  *.  END  =  1010)  Tl.  VT  (NV  +  1) 

NV  =  NV+  1 


IF  (NW  .GT.  2048)  THEN 
CALL  CLEAR 
WRITE  (•.  6030) 

WRITE  (*,  •)  ’There  are  more  than  2048  points  in  the  file.’ 
WRITE  (*,  •)  ’Delete  points  and  stan  over.’ 

PAUSE 


.lETURN 


ENr*  IF 

IF  (VT  (NV)  .LT.  PMIN)  PMIN  =  VT  (NV) 
IF  (VI  (NV)  .GT.  PMAX)  PMAX  =  VT  (NV) 
GO  TO  1000 
1010  CONTINUE 
CLOSE  (UNIT  =  7) 


TMAX  =  (NV  -  1)>DTT 

Q  4i  iK  4i  4i  *  4i  iK  4i  4i  4i  4i  K  4i  *  4i  4i  4i  4i  K  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  IK  4i  K  4i  4i  K  K  4i  4i  K  4i  4i  4  K  4i  4i  iK  4<  4i  *  4<  4i  4i  4i  4>  4i  4>  *  iK  «  *  K  K  4i  4i  4> 
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OUTPUT  FILE  IS  CREATED  **‘i‘*****'t'**************'t‘**** 

^^t^Ht*^,^L^|:1tl^>,*^>^,*^l>^***^,!t,^,!tl^H:^,^,^,lt,^,4L^L^,^t^l**^i4l**•>k*******************^*****ik**** 

OPEN  (UNIT  ==  7,  FILE  =  NAMEl) 

REWIND  (7) 

WRITE  (7.  6040)  NV 
WRITE  (7,  6050)  PMAX 
WRITE  (7.  6050)  PMIN 
WRITE  (7.  6050)  TMAX 
WRITE  (7.  6050)  TMIN 
6040  FORMATC  M5) 

6050  FORMATC  15.6) 

8000  FORMATC  •.2F15.6) 

DO  1020  I  =  1.  NV 
T1  =  a  -  1)*DTT 
WRITE  (7,  8000)  Tl.  VT  C) 

1020  CONTINUE 

WRITE  (7.  6060)  GAGE 
6060  FORMATC  •,A6) 

WRITE  (7,  *)  VIN 
WRITE  (7.  *)  CX 
WRITE  (7.  *)  BX 
WRITE  (7,  *)  AX 
CLOSE  (UNIT  =  7) 

RETURN 

END 

*  *  *  *  *  *  *  «  «  *  *  «  *  *  *  «  *  *  4>  **  4<  *  Hr  4> »  *  IK*  *  *  If  *  *  *  *  4>  *  *  «  4>  *  4ii|i  *  Xi  ti*  iK  K  *  IK  *  *  ■*>  *  *  Xi  *  *  >•>  *  If*  *  4»l>  <> 

^********************K**  SUBROUTINE  VU  **i*'****************************** 

^KXI********************************************************************* 

C  Version:  3.0,  January  1992 
C 

C  Written  by:  William  Oberle,  Ballistic  Research  Laboratory 
C 

C  Purpose:  The  purpose  of  this  program  is  to  convert  data  obtained 
C  from  a  closed  chamber  firing  and  read  by  VuPoint 
C  to  the  proper  form  in  use  by  the  smoothing  and  C 
differentiating 

C  routines  of  BRLCB. 

C 

^X>*Xi**iti*****4iXi*****4i*i|i******************************Xi******************* 

SUBROUTINE  VU 
DIMENSION  VT  (2050) 

CHARACTER*20  DRIVE*1,  NAME,  DRIVEl*!,  NAMEl,  FILEC,  HLEV,  FPVT, 

1  A*  1 ,  LINEMO,  GAGE*6,  G*6,  H*9 
CALL  CLEAR 
WRITE  (•,  6000) 

6000  FORMAT(////,10X,’Enter  the  drive  where  the  calibration’, 
l/,10X,’and  voltage  data  is  stored.  'Jf) 

READ  (*,  5000)  DRIVE 
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5000  FORMAT(Ai) 

WRITE  (*,  6010) 

6010  FORMAT(//,10X,’Enter  the  file  name  for  the  calibration’, 
l/,10X,’and  voltage  data.  '  JD 
READ  (•,  5010)  NAME 

5010  FORMAT(A20) 

WRITE  (*,  6020)  DRIVE 

6020  FORMAT(/A10X,’Enter  the  drive  for  the  ouq)ut  file*, 
l/,10X,'which  v^ill  contain  picssure-time  data.  [',Al.’]’y/) 

READ  (*,  5000)  DRIVEl 

IF  (DRIVEl  .EQ.  ’  ’)  DRIVEl  =  DRIVE 

WRITE  (*.  6030) 

6030  FORMAT(////,l OX, ’Enter  the  file  for  the  output  file  which  will’, 

1/,10X, ’contain  the  pressure-time  data  ready  for  BRLCB.  ’, 

2/,10X,’Enter  file  name,  there  can  be  no  extension  for  the  file.’, 

3/.10X,’Note:  This  file  name  will  be  the  name  used  for  all’, 

4/,10X,’other  files  produced  b’,  the  BRLCB  analysis.’, 

5/,10X.’This  is  the  file  name  to  use  when  asked  in  subsequent*, 

6/, lOX, ’options  for  a  file  name.  V/) 

READ  (*,  5010)  NAME! 

^«i4iikiitii<iii4i4<it>iic4<iii**4<4i  NAMES  ARE  DETERMINED  ***>i"i"«"<'4>****’*‘t>*‘'«‘*i<’*‘*4"t-'***’i'** 

^  <1  *  1)1 *  Hi  4i  4ii|i  41 4, 41  i|c  41 1),  4i  4t  <1  *  *  «  *  4r  *  4i  4i  4, 4i  4, 4,  %  *  %  I,.- lie  I|c  4i  *  1)1 4, « 4i  4II||  4i  4i  y  Hi  « I41 4t  lie  Hi  *  4, 


FE-EC  =  DRIVE 
FILEV  =  DRIVE 
FPVT  =  DRIVEl 
FILEC  (2:2)  * 

FILEV  (2:2)  =  ’:’ 

FPVT  (2:2)  =  ’:’ 

FILEC  (3:20)  =  NAME 
FILEV  (3:20)  =  NAME 
FPVT  (3:20)  =  NAMEl 
DO  1000  I  =  1,  20 
A  hLEC  (I:I) 

IF  (A  .EQ.  ’.’  .OR.  A  .EQ.  ’  ’)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 

FILEC  (1:1  +  3)  =  ’CAD’ 

FILEV  (1:1  +  3)  =  ’V.AD’ 

DO  1020  I  =  1,  20 
A  =  FPVT  (1:1) 

IF  (A  .EQ.  ’.’  .OR.  A  .EQ.  ’  ’)  GO  TO  1030 
1020  CONTINUE 
1030  CONTINUE 


FPVT  (1:1  +  3)  =  ’.PVT’ 

^**4i*i*  ik*4i  4i  4i  He  4i  4i  4i  4<*4i  4i***4i  4i******4i  4i*4i«4i  He  4i4i4i4i4i4i4i4i¥4>4i4i4i4i4i4i*4i4i4i4i4i4'»4i4>4i4i*4>  414141*41 

(^4i*4i**.k*«iik4>4i4i4i4>  QAGE  INFORMATION  IS  ENTERED  **************************** 


^4i4i4i4i4i*4ii»4i*4i*4i4i4i4i4i4i4i4i4i4i4i4e4i4i*****»*4i**4i4i4i4>4i4i*4>4i*4e*4i4i4i4i4i4i4i4i4i4i¥4i4i4i4i4i*4i4i4i4i4i4e 
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CAIX  CLEAR 

WRITE  (*,  *)  ’Enter  the  gage  calibration  input  voltage.  ’ 

READ  (*,  *)  VIN 
1040  CONTINUE 
CALL  CLEAR 
WRITE  (*,  *)  ’  ’ 

1050  CONTINUE 

WRITE  ("■,  *)  ’Gage  information  is  required.’ 

WRITE  (*,  *)  ’1,  Use  gage  information  file.’ 

WRITE  (*,  *)  ’2.  Enter  gage  information  interactively.’ 

WRITE  (*,  *)  ’Please  Enter  Your  Choice  (1-2):’ 

READ  (*,  *)  ICHOICE 
IF  aCHOICE  .GT.  2)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  a  1  or  2.’ 

GO  TO  1040 
END  IF 

IF  aCHOICE  .EQ.  1)  THEN 
CALL  CLEAR 
WRITE  (*,  6040) 

6040  FORMAT(////,l OX, ’First  the  gage  information  file  will  be’, 
l/,10X,’provided  to  allow  the  proper  gage  ID  to  be  determined’, 
2/,10X,’the  gage  ID  will  be  us^  to  select  the  required’, 

3/,  1  OX, ’information.  ’  Jf) 

PAUSE 

CALL  MKGAGE 
CALL  CLEAR 

WRITE  (*,  *)  ’Please  enter  tlic  gage  I.D.  as  in  the  gage  file.’ 
WRITE  (*,  *)  ’AU  capital  letters.’ 

READ  (*,  5020)  GAGE 
5020  FORMAT(A6) 

OPEN  (UNIT  =  3,  FILE  =  ’CAGEFILE’,  STATUS  =  ’OLD’) 
READ  (3,  *)  ITN 
DO  10601  =  1.  ITN 
READ  (3,  5030)  G.  H,  CX,  BX,  AX 
5030  FORMAT(A6,A9,3E12.5) 

IF  (GAGE  .EQ.  G)  THEN 
CLOSE  (UNIT  =  3) 

GO  TO  1070 
END  IF 

1060  CONTINUE 

CLOSE  (UNIT  =  3) 

WRITE  (*,  *)  ’The  gage  is  not  in  the  gage  file,  enter’ 

WRITE  (•.  *)  ’the  information  interactively  or  add  to  the’ 
WRITE  (•,  *)  ’the  gage  information  to  the  gage  file.’ 

PAUSE 
CALL  CLEAR 
GO  TO  1050 
1070  CONTINUE 
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CLOSE  (UNIT  =  3) 

END  IF 

IF  (ICHOICE  .EQ.  2)  THEN 
CALL  CLEAR 

WRITE  *)  ’Enter  the  gage  I.D.’ 

WRITE  (♦,  *)  ’All  capital  letters.’ 

6045  FORMAT  (A6) 

READ  (*,  6045  )  GAGE 

WRITE  (*,  *)  ’Enter  the  coefficients  of  the  second  order  fit’ 

WRITE  (*,  •)  ’for  the  conversion  from  voltage  to  MPa.  Start’ 

WRITE  (*,  *)  ’with  the  coefficient  of  the  second  power.  ’ 

WRITE  (*.  *) 

WRITE  (*,  •)  ’Enter  the  coefficient  of  the  second  power.  ’ 

READ  (*.  *)  AX 

WRITE  (*,  •)  ’Enter  the  coefficient  of  the  linear  term.  ’ 

READ  (*,  *)  BX 

WRITE  (*,  *)  ’Enter  the  constant  term.  ’ 

READ  (*.  *)  CX 
END  IF 

Q  *  4i  Hi  4i  *  *  *  <■  *  *  4i  *  *  4i  *  *  *  *  4i  III  4iit>  41 4>  *  *  *  4>  *  «  *  «  *  Hi  i|t  i|>  *  *  *  *  *  *  *  >l<  %  4>  <■  *  *  *  *  *  *  *  *  *  i|< 

^4ii|i**i|i4ii|ii|i4i«*4i4i4i4i4ii|i4i4i4i4ii|t4i4i4i  DATA  CONVERSION 

^  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *41  *  Hi  *  *  »  <■  «■  «■  *  *  *  *  Hi  *  *  »  «  *  «  Hi  «  *  4i  *  *  *  *  *  *  *  m  4i  *  *  *  <1 4i  Hi  *  *  «  *  «  *  *  *  Hi  *  «  *  «  * 

CALL  CLEAR 
WRITE  (*.  6050) 

6050  FORMAT(///////A*  DATA  CONVERSION  IN  PROGRESS’) 

CALL  POINT  (FILEC.  NC) 

IF  (NC  .GT,  2048)  THEN 
CALL  CLEAR 

WRITE(*,*)’  There  are  more  than  2048  points  in  the  input  file.’ 

WRITE(*,*)’  Delete  sufficient  points  from  the  calibration  file’ 

WRITE  (*,  *)  ’  and  start  over.’ 

PAUSE 
RETURN 
END  IF 

OPEN  (UNIT  =  7,  FILE  »  FILEC) 

REWIND  (UNIT  =  7) 

DO  1080  I  »  1,  13 
READ  (7,  5040)  LINE 
5040  FORMAT(A40) 

1080  CONTINUE 
DO  1090  I  =  1,  NC 
READ  (7,  *)  Tl,  VT  (1) 

1090  CONTINUE 
CLOSE  (UNIT  =  7) 

1100  CONTINUE 

DO  1110KK»  l.NC 
IF  (VT  (KK)  .GT.  0.0)  THEN 
N2  »  KK  -  3 


GOTO  1120 
END  IF 

1110  CONTINUE 
1120  CONTINUE 
N4  =  NC  -  3 
N1  =  3 

1130  CONTINUE 
VMIN  =  0.0 
VMAX  =  0.0 
DO  1140I  =  N1.N2 
VMIN  =  VMIN  +  VT  0) 

1140  CONTINUE 

VMIN  =  VMIN/(N2  -  N1  +  1) 

DO  1150I  =  N3.  N4 
VMAX  =  VMAX  +  VT  a) 

1150  CONTINUE 

VMAX  =  VMAX/(N4  -  N3  +  1) 

CALL  CLEAR 
WRITE  (*.  *)  ’  ’ 

WRITE  (*.  6060)  VMIN,  VMAX 
6060  FORMATC  ’.’Minimum  calibration  voltage  =  ’J^lO.Sy, 

1  ’  Maximum  calibration  voltage  =  ’,F10.S) 

PAUSE 

^Ili4i«*ikik4i*4iiti*i|i***«i|i**4ii(i*iti«i*****4t**«**4t*4>«4i4i*4i«i**4i4i*#«*»*********#**»«i**** 

C******-********  CONVERSION  FACTOR  IS  COMPUTED  ***••*••**•***••*•**■ 

Q  =  1000.0*VIN 
F  =  Q/(VMAX  -  VMIN) 

^*i|iitr*4i*4i4i«>*4>«c4>i|>«i***««i**********4>**«i«i«*************'********«**»»»«**»*»** 

(^4.«**4,«*****«**  VOLTAGE  DATA  IS  READ  AND  CONVERTED  TO  MPa  •**••• 

. . . . . 

WRITE  (*.  6070) 

6070  FORMATC///, lOX.’Entcr  the  time  step  for  the  data  in  millisccs.’) 

WRITE  (•.  6080) 

6080  FORMATC///) 

READ  C*.  *)  DTT 
DTT  «  DTT/1000. 

TMIN  «  0.0 

CALL  POINT  CFILEV.  NV) 

IF  CNV  .GT.  2048)  THEN 
CALL  CLEAR 

WRITEC*,*)’  There  ire  more  thin  2048  points  in  the  input  file,’ 

WRITEC^.*)'  Delete  sufficient  points  from  the  calibration  file' 

WRITE  C*.  •)  *  and  start  over.’ 

PAUSE 
RETURN 
END  IF 

OPEN  CUNTT  »  7,  FILE  »  FILEV) 
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REWIND  (7) 

DO  11601  =  1.  13 
READ  (7,  5040)  LINE 
1160  CONTINUE 

READ  (7.  ♦)T1.  VT(1) 
TEMP=  VT(I)-  VMIN 
TEMP  =  TEMP*F 


VT  (1)  =  AX*TEMP*TEMP  +  BX*TEMP  +  CX 
PMAX  =  VT(1) 

PMIN  =  PMAX 
DO  11701  =  2.  NV 
READ  (7.  •)  Tl.  VT  0) 

TEMP  =  VT  (I)  -  VMIN 
TEMP  =  TEMP*F 

VT  0)  =  AX*TEMP*TEMP  +  BX*TEMP  +  CX 
IF  (VT  0)  LT.  PMIN)  PMIN  =  VT  0) 

IF  (VT  0)  GT.  PMAX)  PMAX  =  VT  (I) 

1170  CONTINUE 
CLOSE  (7) 


TMAX  =  (NV  -  1)*DTT 


^4i****«*«****«,«.«<*«****  WRITING  OUTPUT  FILE  ***************************** 

^**«»««*4i4i4i«*«***«>4i******4r4ii**i|i*«i*********«i*«'**4r4i**i|i:»4>4i4t4i«>*4i**«i***4<*«>«i**» 


OPEN  (UNIT  =  7.  FILE  =  FPVT) 
REWIND  (7) 

WRITE  (7.  6090)  NV 
WRITE  (7,  6100)  PMAX 
WRITE  (7.  6100)  PMIN 
WRITE  (7,  6100)  TMAX 
WRITE  (7,  6100)  TMIN 
6090  FORMATC  M5) 

6100  FORMATC  *^15.6) 

8000  FORMATC  ViF15.6) 

DO  11801  =  1.  NV 
Tl  =  (I  -  1)*DTT 
WRITE  (7,  8000)  Tl.  VT  (I) 
1180  CONTINUE 

WRITE  (7.  61 10)  GAGE 
6110  FORMATC  •.A6) 

WRITE  (7,  •)  VIN 
WRITE  (7,  •)  CX 
WRITE  a,  *)  BX 
WRITE  (7.  *)  AX 
CLOSE  (7) 

RETURN 

END 


SUBROUTINE  POINT 


2II 
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SUBROUTINE  POINT  (F.  N) 
CHARACTER  A*40,  F*20.  B*21 
OPEN  (UNIT  8,  FILE  =  F) 
REWIND  (8) 

DO  1000  I -1.9 
READ  (8.  5000)  A 
5000  FORMAT(A40) 

1000  CONTINUE 
READ  (8,  5000)  A 
BACKSPACE  (8) 

IF  (A  (23:23)  .EQ.  *"*)  THEN 
READ  (8.  5010)  B.  N 
ELSE 

IF  (A  (24:24)  .EQ.  **•*)  THEN 
READ  (8.  5020)  B.  N 
ELSE 

IF  (A  (25:25)  .EQ.  ’"’)  THEN 
READ  (8.  5030)  B.  N 
ELSE 

READ  (8.  5040)  B.  N 
END  IF 
END  IF 
END  IF 

5010  FORMAT(A21,Il) 

5020  FORMAT(A2I.I2) 

5030  FORMAT(A21,I3) 

5040  FORMAT(A21.I4> 

CLOSE  (UNIT  =  ^ 

RETURN 

END 


*************** 


SUBROUTINE  CLEAR 


SUBROUTINE  CLEAR 
CHARACTER  ST*4 
DATA  ST/*  12J*/ 
WRITE  (*.  6000)  ST 
0  FORMAT  (1X.A4) 
RETURN 
END 


SUBROUTINE  MKGAGE 


SUBROUTINE  MKGAGE 
Veision:  1. 0.  January  II,  1989 
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C  Written  by:  William  Oberte,  U.S.  Army  Research  Laboratory 
C 

C  Purpose:This  program  maintains  a  data  base  for  gages  used 
C  in  the  BRLCB  data  reduction  program.  The  data 
C  file  is  GAGEFILE  and  should  be  on  the  same  drive 
C  as  the  program. 

^****««>4i*4i4i4i***4i***«r*«4<*«******4i4i«i***»»*«*4i**4i**«i*i»4i«i«ai««**i*«i4i4i«i*««*4t**» 

CHARACTER  AG  (100)*6.  BG  (100)*9.  XGAGE*6.  YGAGE*6.  XTEMP*1 
DIMENSION  CG  (100.  3) 

DO  10001=  1,  100 
AG  0)  =  ’ 

BG  (I)  =  ’ 

CGd  1)  =  0.0 
CG  (I.  2)  =  0.0 
CG  (I.  3)  »  0.0 
1000  CONTINUE 


(;>4i***«****«»««***  Jijg  g3gg  jjie  is  *4.«4.*»**«.*»«,*«.*«I*«.«,«|*****« 


CALL  READER  (ITN.  AG.  BG.  CG) 


C***********  The  number  of  pages  is  determined. 


1010  CONTINUE 

IF  ((ITN  .GE.  1)  .AND.  (ITN  .LE.  20))  NPAGE  =  1 
IF  ((ITN  .GE.  21)  AND.  (ITN  .LE.  40))  NPAGE  =  2 
IF  ((ITN  .GE.  41)  AND.  (ITN  LE.  60))  NPAGE  =  3 
IF  ((ITN  .GE.  61)  .AND.  (ITN  .LE.  80))  NPAGE  =  4 
IF  (GTN  GE.  81)  .AND.  (ITN  .LE.  lOO))  NPAGE  = 


The  gage  sub-menu  is  presented. 


1020  CONTINUE 
CALL  CLEAR 
WRITE  (•.  6000) 

6000  FORMATC  '.T30.'Gage  Maintenance  Program') 

WRITE  (*.  6010) 

6010  FORMATC  •.'n8.*Sub  Menu') 

WRITE  (•.  •) 

WRITE  (*.  •) 

WRITE  (*,  *)  ■  1.  View  gage  information.' 

WRITE  (*.  •)  ’  2.  Add  a  gage  to  data  base.' 

WRITE  (*,  *)  '  3.  Delete  a  gage  from  data  base.' 

WRITE  (*,  *)  '  4.  Locate  specific  gage  in  data  base.' 

WRITE  (*,  *)  ’  5.  Exit.' 

WRITE  (*.  •) 

WRITE  (•.  •)  '  Please  Enter  Your  Choice  (1-5):  ' 

READ  (*.  *)  ICHOICE 
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IF  OCHOICE  ,GT.  5)  THEN 
WRITE  (*.  *) 

WRITE  (*,  *)  'The  choice  you  have  made  is  not  between’ 

WRITE  (*,  •)  '1  and  5.  Please  select  again.’ 

GO  TO  1020 
END  IF 

C*******  The  proper  action  is  taken  depending  on  the  selection.  ******** 

Q*1,*tiiHHi*4i*»**************************m******it‘***********m************** 

IF  GCHOICE  .EQ.  5)  GO  TO  1030 
IF  GCHOICE  .EQ.  1)  THEN 
IF  (ITN  .EQ.  0)  THEN 
CALL  CLEAR 

WRITE(*,*)’There  are  no  gages  in  the  gage  information  file.’ 

WRITE  (*,  *)  ’Enter  another  option.* 

PAUSE 
GO  TO  1020 
END  IF 
CALL  CLEAR 
WRITE  (*.  *) 

1040  CONTINUE 

WRITE  (•,  6020)  ITN 

6020  FORMAT(’  ’.’There  are  ’,13,’  entries  in  the  gage  data  file.’) 

WRITE  (*.  6030)  NPAGE 

6030  FORMAT!’  ’.This  information  is  displayed  in’,I3.’  screen  pages.’) 

WRITE  (•,  6040) 

6040  FORMAT!’  ’.’Which  page  would  you  like  to  view?  ’) 

READ  !*.  •)  IPAGE 
IF  !IPAGE  .GT.  NPAGE)  THEN 
WRITE  !*,  *) 

WRITE  !*,  *■)  ’The  choice  you  have  made  is  not  in’ 

WRITE  !*,  *)  ’the  proper  range.  Please  select  again.’ 

GO  TO  1040 
END  IF 

CALL  HEADER 

CALL  PAGER  !ITN.  IPAGE.  AG,  BG.  CG) 

GOTO  1010 

(^*****4i************e«'^****4>«i******4>*****<:«i****************«*******«i**«i** 

(^***4i****«**«i*«.******  of  Option  1.  ***************************** 


END  IF 


c**< 

c**< 

c**< 


Option  2 


IF  GCHOICE  .EQ.  2)  THEN 
CALL  GAGEADD  !ITN.  AG.  BG.  CG) 
GO  TO  1010 
END  IF 
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^ * i« 4<  it<4i* Hi* * *«*  *41  Di ****** 4t itiik* 4i 4> 4i4i <1 4«|c*  ** >l«t<  4<***4<* it> *  4<  * >l>  4> *<« >l< *  * 

^***************************  Qp^iof)  3  ********************************** 

Q*********************************************************************** 


IF  (ICHOICE  .EQ.  3)  THEN 
CALL  DROPPER  (TTN.  AG.  BG.  CG) 

GO  TO  1010 
END  IF 

^*********************************************************************** 
Q***************************  Qp^iQD  4  ********************************** 
Q*********************************************************************** 


IF  (ICHOICE  .EQ,  4)  THEN 
CALL  CLEAR 
1050  CONTINUE 


WRITE  (*,  •)  ’Enter  the  I.D.  number  of  the  desired  gage.  ’ 
WRITE  (*,  •)  ’Enter  all  letters  as  capital  letters.’ 

READ  (*.  5000)  XGAGE 
5000  FORMAT(A6) 

1060  CONTINUE 
YGAGE  =  ’ 


IF  (XGAGE  .EQ.  ’  ’)  GO  TO  1050 

(^*********************************************************************** 
C********  Test  is  determine  if  xgage  starts  with  a  blank  ********i'****** 
^*********************************************************************** 


IF  (XGAGE  (1:1)  .EQ.  ’  ’)  THEN 
DO  1070  II  =  2,  6 

YGAGE  ai  -  1:11  -  1)  =  XGAGE  (1:1) 
1070  CONTINUE 

XGAGE  =  YGAGE 
GO  TO  1060 
END  IF 


^*********************************************************************** 


^*********************  search  begins  *4"*"i"*"*"*"*' *'*"*■*'<■  4"*"*' 4"*"* 

Q****»************************************************** **************** 

DO  1080  I  =  1,  ITN 
IF  (XGAGE  EQ.  AG  (I))  THEN 
WRITE  (*,  *)  ’A  match  has  been  found.’ 

WRITE  (•,  *) 

WRITE  (•,  *) 

PAUSE 

CALL  HEADER 

WRITE  (*.  6050)  I.  AG  (I).  BG  (I).  CG  (I.  1).  CG  (I,  2).  CG  (I.  3) 

6050  FORMAT(’  ’.13.2X.A6,2X.A9.3X.E12.5.6X.E12.5.6X£12.5) 

WRITE  (*.  *) 

WRITE  (*,  *)  ’Press  Enter  to  Continue.  ’ 

READ  (•.  5010)  XTEMP 
5010  FORMAT(Al) 

GO  TO  1010 
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END  IF 

1080  CONTINUE 


WRITE  (*,  *)  ’The  gage  is  not  in  the  table.’ 

WRITE  (*,  *)  ’Press  Enter  to  Continue.  ’ 

READ  (♦.  5010)  XTEMP 
GO  TO  1010 

Qvvvvvvvvvvvvvvvvv*  This  is  the  end  of  option  4.  *********************** 

04<4<4<4<4<4<4<V4<4<4<4<4<V<I<<I<4<4<4<4<4I4<4<4<4<4<V4<V4<4<VVVVVVVVVVV4<V4<4<VVVVV4<V4<4<4<4<4<V4<VVVVVVVV4<V4< 


END  IF 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 

0VVVVVVVVVV  To  exit  the  program  the  gage  file  is  written,  wvvvvvvvvvvw 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 


1030  CONTINUE 

OPEN  (UNIT  =  8.  FILE  =  ’GAGEFILE’) 

WRITE  (8.  •)  ITN 
DO  10901  =  1.  ITN 

WRITE  (8,  6060)  AG  (I).  BG  0).  CG  (I.  1).  CG  (I,  2),  CG  (I.  3) 
1090  CONTINUE 
6060  FORMAT(A6.A9.3E12.5) 

CLOSE  (UNIT  =  8) 

RETURN 

END 


0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 


SUBROUTINE  HEADER 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 


CALL  CLEAR 

WRITE  (*,  *)  ’  The  data  fit  is  of  the  form:  A  +  Bx  +  Cx''2’ 

WRITE  (*,  6000) 

6000  FORMAT(’  ’,’  #’,4X.’I.D.’,3X,’Cal.  Date’.8X.’A’.18X,’B’.18X,’C’) 
WRITE  (*,  6010) 

6010  FORMAT(’  ’,80(’-’)) 

RETURN 

END 


0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 

SUBROUTINE  PAGER  (ITN.  IPAGE,  AG,  BG.  CG) 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 


CHARACTER  AG  (100)*6,  BG  (100)*9 
DIMENSION  CG  (100,  3) 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 


0VVVVVVV  Jest  to  see  if  there  are  entries  on  the  chosen  page,  vwvvvvwv 

0VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV 

1000  CONTINUE 

IX  =  20*(IPAGE  -  1) 

IF  flX  .LT.  ITN)  GO  TO  1010 

WRITE  (*',  *)  ’There  are  no  entries  on  the  page  selected.’ 

1020  CONTINUE 

WRITE  (*,  •)  ’Please  enter  a  new  desired  page  number.  ’ 
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READ  (*,  •)  IPAGE 
CALL  HEADER 
GO  TO  1000 
1010  CONTINUE 

ISTART  =  20*(IPAGE  -  1)  +  1 
END  =  MINO  (20*EAGE,  ITN) 

DO  1030  I  =  ISTART,  END 

WRITE  (*.  6000)  I,  AG  (I).  BG  0).  CG  0.  1),  CG  (1,  2).  CG  a.  3) 
1030  CONTINUE 

6000  FORMATC  M3.2X.A6.2X.A9.3XJE12.5.6XE12.5,6XE12.5) 

1040  CONTINUE 

WRITE  (*,  *)  'New  page  (1)  or  options  (2)?  ’ 

READ  (•.  *)  lOPT 
E  aOPT  .GT.  2)  THEN 
WRITE  (*.  *) 

WRITE  (*,  *)  ’The  dioice  you  have  made  is  not  a’ 

WRITE  (*,  *)  ’1  or  2.  Please  select  again.’ 

GO  TO  1040 
ENDE 

E  aOPT  .EQ.  1)  GO  TO  1020 

RETURN 

END 


^  4>  *  *  *  *  «  Dull  *  *  *  «>  *  *  «  «  *  *  4>  *  4i  4< «  4<  *  *  *  **  *  41  *  414141 4c  «  «  «  *  *  *  *  4i  Hmc «  it< « i|>  *  4>  *  *  4>  *  *  «  *  *  *  *  *  « 

SUBROUTINE  READER  (ITN,  AG,  BG.  CG) 

^  4>  4>  4i  4>  4i  *  4i  *  4i  4i  4>  4<  4>  4<  4<  4>  4<  4<  *  4<  4c «  *  *  4>  *  *  *  4i  *  *  *  <•  4c  <fc  *  4c  4>  4<  4c  4t  4<  4>  4>  4>  Kc  4»l>  He  *  *  *  *  4<  4>  4c  *  4>  41 4>  4<  4>  4t  4>  *  4>  4>  * 

CHARACTER  AG  (100)*6,  BG  (100)*9 
DIMENSION  CG  (100,  3) 

OPEN  (UNIT  =  7.  FILE  =  ’GAGEFILE’) 

REWIND? 

Q4c44c4c4c*4cc44c*4c4c*4c4c*4c4c*4c*c4c4c44c4c4c4c4c4c4c4c4c4c4c4c4c4c4c444*4c*4c44c44c44444c*44c44c4c4c444i44c44c4c4 

q44c*44c*4c4c44c44c*4c*4c  jj^e  gage  file  is  opened  and  read  4c****4.44c**4c*4c4c*4c4c*4c** 

^44cc444c44c44444c44c**4c4c44c444c4444c44c44cc44c444c4c4c4444444444c4c4c44444444c*4444*4444*44c 


READ  (7.  *)  ITN 
E  (ITN  .EQ.  0)  THEN 
WRITE  (*,  *)  ’The  gage  file  is  empty.’ 

CLOSE  (UNIT  =  7) 

RETURN 

ENDE 

DO  1000  I  =  1.  ITN 

READ  (7.  5000)  AG  (I).  BG  (I),  CXJ  (1.  1).  CG  (I,  2),  CG  (I,  3) 
1000  CONTINUE 
5000  FORMAT(A6.A9.3E12.5) 

CLOSE  (UNIT  =  7) 

RETURN 

END 


(;*4*4«4c*****44.444c44*4.k*«,4c**.**4.*******4c444***. 

SUBROUTINE  GAGEADD  (ITN,  AG.  BG.  CG) 


c4*4 
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n  o  o  n 


^  itiiti  %  4i  III  <1 4>  4>  *  4i  <1  *  *  1(1  *  4i  III  *  #  <1 4i  4i  4r  *  *  *  *  4i «  «  4i  %  4>  it<  111  If  4<  4f  4i  4i  lie  4i  4i  4>  i|<  III  <*•  Hi  4>  i|<  4t  >!■  >l<  *  t  4<  4<  4<  4>  * 

CHARACTER  AG  (100)*6.  BG  (100)*9.  XGAGE*6.  YGAGE*6 
DIMENSION  CG  (100,  3) 

ITN  =  ITN  +  1 
IF  (ITN  .GT.  100)  THEN 
WRITE  (*,  *)  ’No  room  left  in  the  gage  data  file.’ 

WRITE  (*,  *)  ’Return  to  menu  and  delete  unwanted  gages.  ’ 

PAUSE 
RETURN 
END  IF 
CALL  CLEAR 
1000  CONTINUE 

WRITE  (*,  *)  ’  Please  enter  the  gage  ID.  ’ 

WRITE  (*,  *)  ’  Enter  all  letters  as  capital  letters.’ 

READ  (*,  5000)  XGAGE 
5000  FORMAT(A6) 

1010  CONTINUE 
YGAGE  =  ’ 

IF  (XGAGE  .EQ.  ’  ’)  GO  TO  1000 

^4i4iif4i4i4i*4i**4i4i*4i*4iiii4i4ii|ii|ii|ii|i«4i«i|i4i4i4i4i4i*4if4i4i4i*4i4i4ii|i4if4ii|ii|ii|ii|ii|ii|i4i4i*i|i4i4i4i4i4i4i*4i4i4i4i«4ii|i4i 

C*********  Test  is  determine  if  xgage  starts  with  a  blank  *******■)■***♦** 

Qm***!^m*tt,t**0t******‘itL*******’******>********************************‘****** 

IF  (XGAGE  (1:1)  .EQ.  ’  ’)  THEN 
DO  1020  II  =  2.  6 

YGAGE  ai  -  1:11  -  1)  =  XGAGE  (1:1) 

1020  CONTINUE 

XGAGE  =  YGAGE 
GO  TO  1010 
END  IF 

AG  (ITN)  =  XGAGE 

WRITE  (*,  *)  ’Enter  the  date  of  gage  calibration  (mm/dd/yy).  ’ 

READ  (*.  5010)  BG  (ITN) 

5010  FORMAT(A9) 

WRITE  (*,  *)  ’Calibration  constants  must  produce  pressure  in  MPa’ 

WRITE  (*,  *)  ’The  form  of  the  data  fit  is:  P(MPa)  =  A  +  Bx  +  Cx''2’ 

WRITE  C",  *)  ’Enter  the  value  for  A:  ’ 

READ  (*,  •)  CG  (ITN.  1) 

WRITE  (*,  *)  ’Enter  the  value  for  B:  ’ 

READ  (*,  •)  CG  (ITN.  2) 

WRITE  (*,  *)  ’Enter  the  value  for  C:  ’ 

READ  (•,  •)  CG  (ITN.  3) 


Now  a  search  is  performed  to  determine  if  the  new  entry  supercedes 
a  earlier  data  set. 


DO  10301  =  I.ITN-  1 
IF  (XGAGE  .EQ.  AG  (I))  THEN 
WRITE  (*,  *)  ’The  gage  added  to  the  data  ba.se  was  already  in’ 
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WRITE(*,*)’the  data  base.  The  eariier  entry  will  be  tagged’ 
WRITE  (*,  *)’with  a  as  the  last  character  of  the  I.D.  field.’ 
XGAGE  (6:6)  = 

AG  a)  =  XGAGE 
WRnE  (*.  *) 

PAUSE 
END  IF 

1030  CONTINUE 
RETURN 
END 


Q  %  4>  *  4t  Di  4i  **  4i  ***  *111  *  m  *««*»***  4<  4«t<  ***********  ♦  4«t' «****  A***  Hi  X< 


SUBROUTINE  DROPPER  (TTN.  AG.  BG.  CG) 


^*********************************************************************** 


CHARACTER  AG  (100)*6,  BG  (100)*9 
DIMENSION  CG  (100,  3) 

CALL  CLEAR 

WRITE  (*,  *)  ’Enter  the  number  for  the  line  in  the  gage  data  file’ 

WRITE  (•,  ♦)  ’to  be  deleted.  This  is  not  the  gage  I.D.  ’ 

P£AD  (*,  *)  IDEl. 

^*********************************************************************** 


(^**********  ^***  Shifting  the  entries  in  the  table.  ***•*******♦*♦***♦■••*♦ 

^************ii******»*********************«<***************************** 


DO  1000  I  =  IDEL  +  1,  TTN 
AG  a  -  1)  =  AG  0) 

BG  (I  -  1)  =  BG  0) 

CG  (I  - 1. 1)  =  CG  a  1) 
CG  (I  -  1,  2)  =  CG  a.  2) 
CG  (I  -  1,  3)  =  CG  a.  3) 
1000  CONTINUE 


TTN  =  ITN  -  1 


RETURN 

END 

^****************»*»****************************************«*********** 
^p*******************  suBKOUTif^E  BSCII  *****f****'*"i'«'**"i>*«'*«'«'*4'*^4'*****'»* 
^**************«******************************************************** 


SUBROUTINE  BSCII 
DIMENSION  VT  (2050) 

CHARACTER*20  NAME.  NAMEl.  GAGE*6 
CALL  CLEAR 
WRITE  (*.  6000) 

6000  FORMAT(//,10X.’Enter  the  file  name  for  the  pressure  data,’, 
l/.lOX.’include  drive  and  extension.  '. 

2/.10X,’lt  is  expected  that  the  data  will  be  in  one’, 
3/,10X,’coIumn,  pressure.  The  pressure  must  be  in’, 

4/,  1  OX, 'metric  units  of  MPa.  If  the  pressure  is  not’, 

S/,10X,'in  MPa.  it  must  first  be  converted.  A  maximum’. 
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6/,10X,‘of  2048  pressure  points  is  allowed.  V//) 

READ  (•,  5000)  NAME 
CALL  CLEAR 
WRITE  (*.  6010) 

6010  FORMAT(////,l OX, ’Enter  the  file  for  the  output  file  which  will’, 
l/,10X,’contam  the  pressure-time  data  ready  for  BRLCB.  ’, 

2/,10X,’Enter  file  name,  all  DOS  path  conventions  apply,’, 

3/,10X,’but  there  can  be  no  extension  for  the  file.’, 

4/.10X,’Note;  This  file  name  will  be  the  name  used  for  all’, 

S/,10X,’other  files  produced  by  the  BRLCB  analysis.’, 

6/,10X,’This  is  the  file  name  to  use  when  asked  in  subsequent’, 

7/,10X,’options  for  a  file  name. ’7/) 

READ  (*,  5000)  NAMEl 
5000  FORMAT(A20) 

CALL  CKNAME  (NAMEl) 

CALL  CLEAR 

*  4ii|t  *  41  *  «  *  «  4i  *  *111  *  *  <1  *  *  *  1)1  *  lit  4t  41  *  Hi  it>  4<  *  «  *  *  «  *  *  « 1(1  *  *  «  *  «  *  *  *  *  itt  lit « III  III  Hi  III  41 4i «  *  41  *  *  «  4ii|>  i|.  Ill  III 

C*******  GAGE  INFORMATION  IS  STILL  REQUIRED  FOR  THE  FILE  *************** 
^*********************************************************************** 

GAGE  =  ’None’ 


AX  =  0.0 
BX  =  0.0 
CX  =  0.0 
VIN  =  0.0 

^***********41*********************************************************** 

^***********«******  ot/TPUT  FILE  IS  CREATED  '•"•■*'***<*"i'**i"*'******'*4'**<>*****<<' 
^**********************««******************»**************************** 
(l^******************  Pressure-time  data  is  read  ****••*•**•******•******• 
^***********************«*********************************************** 
CALL  CLEAR 
NV=  1 


OPEN  (UNIT  =  7,  FILE  =  NAME) 
REWIND  (7) 

READ  (7,  *)  VT  (1) 

T1  =  0.0 


PMAX  =  VT  (1) 

PMIN  ®  PMAX 
WRITE  (*,  6020) 

6020  FORM AT(///,1  OX, ’Enter  the  time  step  for  the  data  in  miUisecs.’) 

WRITE  (•,  6030) 

6030  FORMAT(///) 

READ  (•.  •)  DTT 
DTT  =  DTT/1000. 

TMIN  =  0.0 
1000  CONTINUE 

READ  (7.  •,  END  «  1010)  VT  (NV  +  1) 

NV»NV  +  1 

IF  (NV  .GT.  2048)  THEN 
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non 


CALL  CLEAR 


WRITE(*,*)’  There  are  more  than  2048  points  in  the  input  file.’ 
WRITE  (*,  *)  ’  Delete  sufficient  points  and  start  over.’ 

PAUSE 
RETURN 
END  IF 

IF  (VT  (NV)  .LT.  PMIN)  PMIN  =  VT  (NV) 

IF  (VT  (NV)  .GT.  PMAX)  PMAX  =  VT  (NV) 

GO  TO  1000 
1010  CONTINUE 
CLOSE  (UNIT  =  7) 

TMAX  =  (NV  -  1)*DTT 


OUTPUT  FILE  IS  CREATED  **************************** 


OPEN  (UNIT  =  7,  FILE  =  NAMEl) 
REWIND  (7) 

WRITE  (7.  6040)  NV 
WRITE  (7.  6050)  PMAX 
WRITE  (7,  6050)  PMIN 
WRITE  (7.  6050)  TMAX 
WRITE  (7.  6050)  TMIN 
6040  FORMAT(’  ’,15) 

6050  FORMATC  ’J’15.6) 

8000  FORMAT(’  •,2F15.6) 

DO  1020  I  =  1.  NV 
T1  =  (I  -  1)*DTT 
WRITE  (7,  8000)  Tl.  VT  (I) 

1020  CONTINUE 

WRITE  (7,  6060)  GAGE 
6060  FORMATC  'M) 

WRITE  (7,  •)  VIN 
WRITE  (7.  •)  CX 
WRITE  (7.  •)  BX 
WRITE  (7.  •)  AX 
CLOSE  (UNIT  =  7) 

RETURN 

END 


SUBROUTINE  CSQI 


SUBROUTINE  CSCIl 
DIMENSION  VT  (2050) 

CHARACTER*20  NAME.  NAME!.  GAGE*6.  G*6 
CALL  CLEAR 
WTUTE  (*.  6000) 

6000  R)RMAT(//,10X,’Enter  the  file  name  for  the  voltage  and’, 
l/.lOX.’Ume  data,  include  drive  and  extension. 
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2/,10X,’It  is  expected  that  the  data  will  be  in  two’, 

3/,  1  OX, ’columns,  time  &  voltage.  A  maximum’, 

4/,10X,’of  2048  time^rcssurc  pairs  is  allow^.’^//) 

READ  (*,  5000)  NAME 
CALL  Q-EAR 
WRITE  (•,  6010) 

6010  FORMAT(////,10X, ’Enter  the  file  for  the  output  file  which  wiU’, 
l/,10X,’contain  the  pressure-time  data  ready  for  BRLCB. 
2/,10X,’Enter  file  name,  all  DOS  path  conventions  apply,’, 
3/,10X,’but  there  can  be  no  extension  for  the  file.’, 

4/.10X,’Note:  This  file  name  will  be  the  name  used  for  all’. 


5/,10X,’other  files  produced  by  the  BRLCB  analysis.’, 
6/,10X,’This  is  the  file  name  to  use  when  asked  in  subsequent’, 
7/,10X,’options  for  a  file  name.’//) 

READ  (*,  5000)  NAMEl 
50ai  FORMAT(A20) 

CALL  CKNAME  (NAMEl) 


Qttilt^:**^******************************************'*********************** 


GAGE  INFORMATION  IS  ENTERED  **************************** 

Q4tttit****if****iti********Hi*tHi********i^*******ifiti********lt************m****** 

CALL  CLEAR 
VIN  =  0.0 
1000  CONTINUE 
CALL  CLEAR 
WRITE  (*,  *)  •  ’ 

1010  CONTINUE 

WRITE  (•,  *)  ’Gage  information  is  required.’ 

WRITE  (•,  •)  ’1.  Input  gage  ID  &  use  Gage  File.’ 

WRITE  (•,  •)  ’2.  Review  Gage  File.’ 

WRITE  (*,  *)  ’3.  Enter  gage  information  interactively.’ 

WRITE  (*,  •)  ’Please  Enter  Your  Choice  (1-3):’ 

READ  (•,  •)  ICHOICE 
IF  (ICHOICE  .GT.  3)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  a  I,  2  or  3.’ 

GOTO  1000 
END  IF 

IF  (ICHOICE  .EQ.  2)  THEN 
CALL  CLEAR 
WRITE  (*,  6020) 

6020  FORMAT(////,10X,’Fir5t  the  gage  infonnation  file  will  be’, 

I/,10X,*piDvidod  to  allow  the  proper  gage  ID  to  be  dciermincd’, 

2/,10X,*the  gage  ID  will  be  used  to  select  the  required’, 

3/,10X.’infonnaUon.’y/) 

PAUSE 

CALL  MKGAGE 
END  IF 

IF  (OCHOICE  .EQ.  1)  .OR.  OCHOICE  .EQ.  2))  THEN 
CALL  CLEAR 
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non  n  n  n 


WRITE  (*,  *)  ’Please  enter  the  gage  I.D.  as  in  the  gage  file.’ 
WRITE  (*.  *)  ’All  capital  letters.’ 

READ  (*,  5010)  GAGE 
5010  FORMAT(A6) 

OPEN  (UNIT  =  3,  FILE  =  ’GAGEFILE’,  STATUS  =  ’OLD’) 
READ  (3.  •)  ITN 
DO  1020  I  =  1.  ITN 
READ  (3.  5020)  G.  H.  CX.  BX.  AX 
5020  FORMAT(A6.A9.3E12.5) 

IF  (GAGE  .EQ.  G)  THEN 
GO  TO  1030 
END  IF 

1020  CONTINUE 

CLOSE  (UNIT  =  3) 

WRITE  (*,  •)  ’The  gage  is  not  in  the  gage  file,  enter’ 

WRITE  (*,  *)  ’the  information  interactively  or  add  to  the’ 
WRITE  (*,  •)  ’the  gage  infonnation  to  the  gage  file.’ 

PAUSE 
CALL  CLEAR 
GO  TO  1010 
1030  CONTINUE 

CLOSE  (UNIT  =  3) 

END  IF 

IF  aCHOICE  .EQ.  3)  THEN 
CALL  CLEAR 

WRITE  (•.  •)  ’Enter  the  gage  I.D.’ 

WRITE  (*.  •)  ’AU  capital  Icitcre.’ 

READ  (•.  5010)  GAGE 

WRITE  (*,  *)  'Enter  the  coefficiems  of  the  second  order  fit’ 
WRITE  (•,  •)  ’for  the  conversion  from  voltage  to  MPa.  Stan’ 
WRITE  (*,  *)  ’with  the  coefficient  of  the  second  power.  ’ 
WRITE  (*.  •) 

WRITE  (•,  •)  'Enter  the  coefficient  of  the  second  power.  ’ 
READ  (•.  •)  AX 

WRITE  (*,  *)  'Enter  the  coefficient  of  the  linear  tenn.  ’ 
READ  (•.  *)  BX 

WRITE  (•,  •)  'Enter  the  constant  tenn.  ’ 

READ  (•.  •)  CX 
END  IF 


DATA  CONVERSION 


CALL  CLEAR 


VOLTAGE  DATA  IS  READ  AND  CONVERTED  TO  MPa 


CALL  CLEAR 
WRITE  (*,  6030) 
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n  n  o 


6030  FORMAT(///,10X, ’Enter  the  time  step  for  the  data  in  millisecs.’) 

WRITE  (*,  6040) 

6040  FORMATC///) 

READ  (*.  *)  DTT 
DTT  =  DTT/1000. 

CALL  CLEAR 
WRITE  (*,  6050) 

6050  FORMATC////////,*  DATA  CONVERSION  IN  PROGRESS’) 

TMIN  =  0.0 

OPEN  (UNIT  =  7.  FILE  =  NAME) 

REWIND  (7) 

NV=  1 

READ  (7,  *)  Tl.  VT  (1) 

TEMP  =  VT  (1) 

VT  (1)  =  AX*TEMP*TEMP  +  BX*TEMP  +  CX 
PMAX  =  VT  (1) 

PMIN  =  PMAX 
1040  CONTINUE 

READ  (7,  *,  END  =  1050)  Tl,  VT  (NV  +  1) 

NV  =  NV+  1 
IF  (NV  .GT.  2048)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’There  are  more  than  2048  points  in  the  file.’ 

WRITE  (*,  •)  ’Delete  points  and  start  over.’ 

PAUSE 
RETURN 
END  IF 

TEMP  =  VT  (NV) 

VT  (NV)  =  AX*TEMP^MP  +  BX*TEMP  +  CX 
IF  (VT  (NV)  .LT.  PMIN)  PMIN  =  VT  (NV) 

IF  (VT  (NV)  .GT.  PMAX)  PMAX  =  VT  (NV) 

GO  TO  1040 
1050  CONTINUE 
CLOSE  (7) 

TMAX  =  (NV  •  1)*DTT 


WRITING  OUTPUT  FILE 


OPEN  (UNIT  »  7,  FILE  »  NAMED 
REWIND  (7) 

WRITE  (7.  6060)  NV 
WRITE  a.  6070)  PMAX 
WRITE  (7.  6070)  PMIN 
WRITE  (7.  6070)  TMAX 
WRITE  (7.  6070)  TMIN 
6060  FORMAT(’  ’45) 

6070  FORMATC  ’4^15.6) 

8000  FORMATC  ’,2F15.6) 
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DO  1060  I  =  1.  NV 
T1  =  a  -  1)*DTT 
WRITE  (7.  8000)  Tl,  VT  0) 

1060  CONTINUE 

WRITE  (7,  6080)  GAGE 
6080  FORMATC  ’.A6) 

WRITE  (7.  *)  VIN 
WRITE  (7,  *)  CX 
WRITE  (7.  *)  BX 
WRITE  (7,  *)  AX 
CLOSE  (7) 

RETURN 

END 

SUBROUTINE  DSCII 


SUBROUTINE  DSCII 
DIMENSION  VT  (2050) 

CHARACTER*20  NAME.  NAMEl,  GAGE*6.  G*6 
CALL  CLEAR 
WRITE  (*,  6000) 

6(XK)  FORMAT(//,10X,’Enter  the  file  name  for  the  voltage  data’, 

1/,10X, ’include  drive  and  extension.  ’. 

2/.10X,’It  is  expected  that  the  data  will  be  in  one’, 

3/,  1  OX, 'column,  voltage.  A  maximum’, 

4/,10X,’of  2048  voltage  points  is  allowed.’y//) 

READ  (*,  5000)  NAME 
CALL  CLEAR 
WRITE  (*.  6010) 

6010  FORMAT(////,10X,’Enter  the  file  for  the  output  file  which  will’, 

1/,1  OX, 'contain  the  pressure-time  data  ready  for  BRLCB.  ’, 

2/,10X, 'Enter  file  name,  all  DOS  path  conventions  apply,’, 

3/,10X,’but  there  can  be  no  extension  for  the  file.’, 

4/,10X,’Note;  This  file  name  will  be  the  name  used  for  all’, 

S/,10X, 'other  files  produced  by  the  BRLCB  analysis.’, 

6/.10X,'This  is  the  file  name  to  use  when  asked  in  subsequent’, 

7/,  1  OX, 'options  for  a  file  name.’y/) 

READ  (*.  5000)  NAMEl 

5000  FORMAT(A20) 

CALL  CKNAME  (NAMEl) 

Ik  «  4>  <1  *  •  *  *  *  4t  4i  4t  4t  *  *  «  *  *1^  *  *  4iitr  *  4i  *  *  4>  ||I  *  4i  *  4i  4i  4i  4i  Iliili «  4, 4i  4i  41 1|<  4i  «  4i  «  4ii|,  1*11)1*  *  4t  4<  *  It>  Hi  4c 


(^*4141*41**41**41*4141  GAGE  INFORMATION  IS  ENTERED  **************************** 
(^*********************************************************************** 
CALL  CLEAR 
VIN  =  0.0 
0  CONTINUE 
CALL  CLEAR 
WRITE  (•.  *)  ’  • 
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1010  CONTINUE 

WRrfE  (*,  *)  ’Gage  information  is  required.’ 

WRITE  (*,  *)  ’1.  Input  gage  ID  &  use  Gage  File.’ 

WRITE  (*,  *)  ’2.  Review  Gage  File.’ 

WRITE  (*,  *)  ’3.  Enter  gage  inibrmation  interactively.’ 

WRITE  (*,  *)  ’Please  Enter  Your  Choice  (1-3):’ 

READ  (*,  *)  ICHOICE 
IF  aCHOICE  .GT.  3)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  a  1.  2  or  3.’ 

GO  TO  1000 
END  IF 

IF  aCHOICE  .EQ.  2)  THEN 
CALL  CLEAR 
WRITE  (*,  6020) 

6020  FORMAT(////,10X,’First  the  gage  information  file  will  be’, 
l/.lOX, ’provided  to  allow  the  proper  gage  ID  to  be  determined’, 
2/,10X,’the  gage  ID  will  be  used  to  select  the  required’, 

3/,  1  OX ,  ’information.  ’  Jf) 

PAUSE 

CALL  MKGAGE 
END  IF 

IF  (aCHOICE  .EQ.  1)  .OR.  (ICHOICE  EQ.  2))  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’Please  enter  the  gage  I.D.  as  in  the  gage  file.’ 
WRITE  (*,  *)  ’AU  capital  letters.’ 

READ  (*,  5010)  GAGE 
5010  FORMAT(A6) 

OPEN  (UNIT  =  3,  FILE  =  ’GAGEFILE’,  STATUS  =  ’OLD’) 
READ  (3,  *)  ITN 
DO  1020  I  =  1,  ITN 
READ  (3,  5020)  G,  H,  CX,  BX,  AX 
5020  FORMAT(A6,A9,3E12.5) 

IF  (GAGE  .EQ.  G)  THEN 
GO  TO  1030 
END  IF 

1020  CONTINUE 

CLOSE  (UNIT  =  3) 

WRITE  (*,  *)  ’The  gage  is  not  in  the  gage  file,  enter’ 

WRITE  (*,  *)  ’the  information  interactively  or  add  to  the’ 
WRITE  (*,  *)  ’the  gage  information  to  the  gage  file.’ 

PAUSE 
CALL  CLEAR 
GO  TO  1010 
1030  CONTINUE 

CLOSE  (UNIT  =  3) 

END  IF 

IF  (ICHOICE  .EQ.  3)  THEN 
CALL  CLEAR 
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WRITE  (*.  *)  ’Enter  the  gage  I  D.’ 

WRITE  (*,  *)  ’All  capital  letters.’ 

READ  (*,  5010)  GAGE 

WRITE  (*,  *)  ’Enter  the  coefficients  of  the  second  order  fit’ 
WRITE  (*,  *)  ’for  the  conversion  from  voltage  to  MPa.  Start’ 
WRITE  (■",  *)  ’with  the  coefficient  of  the  second  power.  ’ 
WRITE  (*.  *) 

WRITE  (♦,  •)  ’Enter  the  coefficient  of  the  second  power.  ’ 
READ  (*,  *)  AX 

WRITE  (*,  *)  ’Enter  the  coefficient  of  the  linear  term.  ’ 
READ  (*.  *)  BX 

WRITE  (*,  *)  ’Enter  the  constant  term.  ’ 

READ  (♦,  *)  CX 
END  IF 


QH,t**^,t^,tH,4iii^H,^t******************************************************** 


Qt^i***********************  data  conversion  ***************************** 


Q^t^|^i*:t^i*>ti^i^,lti4ll^^i^l*l^^i**l^l|i*^i^i******l^t*****^Hi*:ll****************ltl******ltl}|l*^l*^l|l 

CALL  CLEAR 


Q  4i «  «  4i «  #  *  *  4t  *  1)1  *  4i  41 4>  4>  *1(1 4i  4<  III  4i  4>  *  «  4i  *  «  4< «  4ii|>  4<  *  4i  4> «  «  « 4t  it< « 1)1  *  «  %  «  « 1)1  ilr  ]«■  *  i|<  4i 


(3**************  VOLTAGE  DATA  IS  READ  AND  CONVERTED  TO  MPa  ************** 
^****************************************1).  ****************************** 

CALL  CLEAR 
WRITE  (*.  6030) 

6030  FORMAT(///,10X, ’Enter  the  time  step  for  the  data  in  millisecs.’) 

WRITE  (*,  6040) 

6040  FORMAT(///) 

READ  (*.  *)  DTT 
DTT  =  DTT/1000. 

CALL  CLEAR 
WRITE  (*,  6050) 

6050  FORMAT(////////.’  DATA  CONVERSION  IN  PROGRESS’) 

TMIN  =  0.0 


NV  =  1 

OPEN  (UNIT  =  7.  FILE  =  NAME) 

REWIND  (7) 

READ  (7,  *)  VT  (1) 

TEMP  =  VT  (1) 

VT  (1)  =  AX*TEMP*TEMP  +  BX*TEMP  +  CX 
PMAX  =  VT  (1) 

PMIN  =  PMAX 
1040  CONTINUE 

READ  (7,  *.  END  =  1050)  VT  (NV  +  I) 

NV  =  NV  +  1 
IF  (NV  .GT.  2048)  THEN 
CALL  CLEAR 

WRITE(*,*)’  There  arc  more  than  2048  points  in  the  input  file.’ 
WRITE  (*,  •)  ’  Delete  sufficient  points  and  start  over.’ 

PAUSE 
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RETURN 
END  IF 

TEMP  =  VT  (NV) 

VT  (NV)  =  AX*TEMP*TEMP  +  BX*TEMP  +  CX 
IF  (VT  (NV)  .LT.  PMIN)  PMIN  =  VT  (NV) 

IF  (VT  (NV)  .GT.  PMAX)  PMAX  =  VT  (NV) 

GO  TO  1040 
1050  CONTINUE 
CLOSE  (UNIT  =  7) 

TMAX  =  (NV  -  1)*DTT 

^  *  41  *  «  %  III  *  4i  :(■  <1*  «  41  %  *  4t  *  III  *  *  4i «  *  4,  iti  4, 4, 1)1 4, 4,  i|<  4, %  4i  4, 41 4iiti  4, 4ii|.  Diitc  4i  4<  ^  4t  III  4<it< «  «  «  4c « 

Q4i4i4i4i4i4i4i4i4i4i4i4i4i4<4i4i4i4<4i4i4i  WRITING  OUTPUT  FILE  ******************'•"•'********* 

^  4i  Hi  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4"|i  4<  *  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4t  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4>  4i  4i  4«|i  4>  4i  4i 

OPEN  (UNIT  =  7,  FILE  =  NAMEl) 

REWIND  (7) 

WRITE  (7.  6060)  NV 
WRITE  (7.  6070)  PMAX 
WRITE  (7.  6070)  PMIN 
WRITE  (7.  6070)  TMAX 
WRITE  (7.  6070)  TMIN 
6060  FORMATC  M5) 

6070  FORMATC  *^^15.6) 

8000  FORMATC  •.2F15.6) 

DO  10601  =  1,NV 
T1  =  (1  -  1)*DTT 
WRITE  (7,  8000)  Tl,  VT  (I) 

1060  CONTINUE 

WRITE  (7.  6080)  GAGE 
6080  FORMATC  •,A6) 

WRDE  (7.  *)  VIN 
WRITE  (7.  *)  CX 
WRITE  (7.  *)  BX 
WRITE  (7,  *)  AX 
CLOSE  (7) 

RETURN 

END 

0 1i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4<  4<  4<  4i  4i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4>  4i  4>  4i  4i  41 4>  4>  4i  4i  4i  4i  4>  4>  4i  4i  4<  4i  4i  4i  4i  %  *  4> 

04i4i*«4i4i4i4i4i4i4i*4i4i4i4i4i4i4i4<ik  SUBROUTINE  CKNAME  *******************t>***t‘****** 

^  4<  *  *  *  4i  4i  4>  4<  *  4i  4i  <1  *  4i  *  4i  *  III  4i  4i  *  *  *  4i  4i  4i »  4i  4i  4i  4<  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  4i 

SUBROUTINE  CKNAME  (NAMEl) 

CHARACTER*20  NAMEl,  A*1 
1000  CONTINUE 
DO  1010  I  =  1,20 
IF  (I  .GT.  15)  THEN 

WRITE  (*,  *)‘File  name  too  long.  Please  enter  a  new  name  which’ 

WRITE  (*,  *)’is  less  than  six  characters  in  length,  not  counting’ 


228 


WRITE  (*.  *)  ’paths.’ 

READ  (*,  5000)  NAMEl 
GO  TO  1000 
END  IF 

A  =  NAMEl  0:1) 

IF  (A  .EQ.  ’.’)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’The  file  name  entered  has  an  extension  which  is’ 
WRITE  (*,  *)  ’not  allowed.  Please  enter  a  new  name  without  ’ 
WRITE  (*,  *)  ’an  extension.’ 

READ  (*.  5000)  NAMEl 
5000  FORMAT(A20) 

GO  TO  1000 
END  IF 

IF  (A  .EQ.  ’  ’)  THEN 
NAMEl  (1:1  +  3)  =  ’.PVT’ 

GO  TO  1020 
END  IF 

1010  CONTINUE 
1020  CONTINUE 
RETURN 
END 
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Intentionally  left  blank. 
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APPENDIX  I: 

LISTING  -  PROGRAM  MKINF.FOR 
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INTENTIONALLY  LEFT  BLANK. 


PROGRAM  MKINF 

CHARACTER*20  NAMEl,  FPVT,  A*l.  NAME2.  HLEO,  FILEI,  A1  (20)*20.  A2  (6)*80 
CHARACTER*20  GAGE 
DIMENSION  A3  (100).  P  (11.  15.  5) 


^  41  I|<  *  *  *  *  III  *  4i  Ik  ||| «  4iitc 41 1|<  *  *  «  4iili « Iti  4i  4i  4. «  4<  ||.  4.  Ill «  *  4i  *  4i  4iit>  14. 4.  *  I|<  4<  %  «  *  *  *  I|<  >•>  >•<  4>  I|<  *  4<  *  *  3*.  4>  >*<  % 


C  Version:  3.0.  January  1992 

C  Last  Modified:  12/28/91  -  added  counter  to  bum  rate 

C  nie 

C  2/9/92  -  Qeanup 

C 

C  Written  by:  William  Oberle,  U.S.  Amty  Research  Laboratory 
C 

C  Purpose:  The  purpose  of  this  program  is  to  obtain  the  necessary 
C  additional  information  required  to  analyze  a  closed 

C  chamber  firing. 

^  4, 4, 4, 4, 4, 4, 4,  ^  4, 4,  ^  4, 4, 4, 4, 4, 4,  ^  4, 4, 4, 4, 4, 4, 1^  4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,  ij,  4, 4, 4, 4, 4, 4i  ^  4,  ^  4, 4, 4, 4,  ^  4, 4, 4,  ^  4, 4i  4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 


^4,414,4,4,4,4,4,^4,4,4,4,4,4,4,4,4,4,  NAMES  ARE  OBTAINED  AND  ♦'•■**********’i‘********* 


Q4i4i4i4i4<4i4i4i4i4i4i>li4iki4i4i4i*4i*4i4i  MASTER  FILE  IS  READ  *********‘**************0‘*** 


^  41 41 41 41 4i  4i  4i  41 4i  41 41 4i  41 4i  41 4i  41 4i  41 4<  4i  4i  4i  4i  41 4<  41 Ik  4i  41 4i  4i  4i  4i  41 4i  41 4i  41 4i  4<  4i  4i  4i  4i  4i  41  k  4i  41 4>  4<  *  4i  4i  4i  4i  4i  4i  4i  4i  41 41 4i  41 4i  4i  4>  * 


1000  CONTINUE 
CALL  CLEAR 
WRITE  (*.  6000) 

6000  FORMAT(20X.’  Firing  InformationV//. 

llOX.'Information  pertaining  to  an  individual  firing  is  entered’ 

2y.l0X.’using  this  option.  The  file  is  built  from  a  Master’ 

3,/.10X.’File  created  using  Option  1.  Enter  the  name  of  the’ 

4y,10X, 'Master  File  which  will  be  used  in  creating  the  current’ 

Sy.lOX.’Information  File,  include  drive  and  extension. ’y/) 

READ  (*.  5000)  NAMEl 
5000  FORMAT(A20) 

OPEN  (UNIT  =  9.  FILE  =  NAMEl.  STATUS  =  ’OLD’.  ERR  =  1010) 

REWIND  (UNIT  =  9) 

^4i4i*4iik4i4iikik4i*4i*ik4i4iik4i4<*«i**4i*4i4iiti4i4i4iik4i4i4i4<4i4i4<4i4>4i4i4i4iik4i4i4i*4>*4i4i4'ikik4i4i4i4i4i4i4i4i4i*4i4>4<4< 

C**********  READING  OLD  MASTER  FILE  TO  BUILD  FROM  *********************** 


Q  Ik  4>  41 4i «  *  *  «  «  *  Ik  Ik  4i  41 41  *  41  *  4ii|i  4i  *  Ik  *  Ik  Ik  4i  41 4i  41  *  *  *  *  *  41  Ik  4i  Ik  Ik  Ik  41  Ik  4i  4i  Ik  4i  41 4i  4i  Ik  4i  41 4<  Ik  41 41 41 4i  4i  4i  4i  4<  4i  Ik  >k  41 4i  *  4i  4i 


DO  10201=  1.6 
READ  (9.  5010)  A2  (I) 
1020  CONTINUE 
5010  FORMAT(A80) 
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DO  1030  I  =  1.  20 
READ  (9.  5000)  A1  (I) 

1030  CONITNUE 
DO  1040  I  =  1.  100 
READ  (9,  *)  A3  0) 

1040  CONTINUE 
DO  1050  I  =  1,  11 
DO  1060  J  =  1.  15 
DO  1070  K  =  1.  5 
READ  (9.  *)  P  a.  J.  K) 

1070  CONTINUE 
1060  CONTINUE 
1050  CONTINUE 
CLOSE  (UNIT  =  9) 

GO  TO  1080 
1010  CONTINUE 

WRITE  (*.  6010)  NAMEl 
6010  FORMAT(//,10X.’The  Master  File:  ’.A20y. 

llOX.’does  not  exist,  check  the  file  name  and  try  again.’) 

PAUSE 
GO  TO  1000 

^  *  4. « >|i  4i  41 4i  *  4t  4. 4i  *  III  *  4<  41  *  4>  *  iti  *  <l<  41  *  it>  *  <■  4>  *  *  4>  *  4c  *  *  i|<  4>  *  4>  *  4> 


(^4.4>4.4<4<4i4<4<4i4<4i4i4i4<4.4<*  TYPE  OF  COMPUTATION  IS  DETERMINED  ***4.4.4.4.4.4.4.4.414.4.4.4.414.4. 
^4>4.*******4.4.************************4.4.4.4.4.*4.4.*4.4.*******4.***************** 


1080  CONTINUE 
CALL  CLEAR 
WRITE  (*.  6020) 

6020  FORM AT(///,10X, ’Enter  the  type  of  computation  which  is  to  be’, 
l/.10X.’perfonned.’y.l5X.’l.  Bum  Rate  Reduction’y,15X. 

2’2.  Inverse  Analysis  (Generate  P/r)’y,15X, 

3’3.  Surface  Area  Analysis’y,15X,’4.  Interrupted  Burner’ y,15X, 

4’5.  ETC  Reduction’) 

READ  (*,  *)  IT'fPE 
A3  (2)  =  ITYPE 


^4.4.*************************4.*******4.4.**4.****4.****************4.********* 


(^4.4.***************  all  other  file  names  are  created  ******************** 

^4.4.*>..*******************************4.4.4.4.4.****4.4.4.**4.***4.***4.***4.********* 


IF  (ITYPE  .NE.  2)  THEN 
1090  CONTINUE 
CALL  CLEAR 
WRITE  (*,  6030) 

6030  FORMAT(20X,’  Firing  Infomiation’y//, 

IlOX, ’Enter  the  name  of  the  Pressure/time  File  created  in’ 


2y,10X, ’Option  3  which  is  associated  with  the  Information  File’ 
3y,10X, ’being  created.  This  file  must  be  created  before’. 


4/,10X,’the  Information  File  is  created.  If  the  PressureAime’ 


5y,10X,’File  does  not  exist,  exit  the  program  and  complete’ 
6y,10X, 'Option  3.  Remember  the  file  name  is  given  without  ’ 
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77,10X, ’extension  but  all  DOS  path  ojxions  ate  applicable.’//) 

READ  (*,  5000)  FPVT 
A1  (5)  =  FPVT 
CALL  MKNAME  (Al) 

OPEN  (UNIT  =  7,  FILE  =  AI  (5).  STATUS  =  ’OLD’,  ERR  =  1 100) 
REWIND  (UNIT  =  7) 

READ  (7,  *)  NV 
READ  (7,  5020)  PMAX 
A3  (43)  =  PMAX 
READ  (7.  5020)  PMIN 
READ  (7.  5020)  TMAX 
READ  (7.  5020)  TMIN 
5020  FORMAT(FI5.6) 

8000  FORMAT(2F15.6) 

DO  11101=  l.NV 
READ  (7,  8000)  Tl.  PI 
1110  CONTINUE 

READ  (7,  5030)  GAGE 
5030  FORMAT(A20) 

Al  (15)  =  GAGE 
READ  (7.  *)  VIN 
A3  (19)  =  VIN 
READ  (7.  *)  CX 
A3  (20)  =  CX 
READ  (7,  *)  BX 
A3  (21)  =  BX 
READ  (7.  *)  AX 
A3  (22)  =  AX 
CLOSE  (UNIT  =  7) 

CALL  CLEAR 

DELTAT  =  (TMAX  -  TMIN)/(NV  -  I.)*  1000. 

CALL  CLEAR 
WRITE  (*.  6040)  DELTAT 

6040  FORMAT(////,I0X,’Thc  time  step  in  recording  the  pressure  data’ 
U.IOX.’is  currently:  ’,F9.6,’  ms.  If  this  is  not  correct  enter’ 

2y,I0X,’a  new  value  for  the  time  step  in  milliseconds. ’y/, 

3l5X,’l.  Accept  current  valuc.’y,15X,’2.  Enter  new  valuc.’y, 

415X, ’Enter  a  1  or  I'J) 

READ  (•,  *)  lie 
IF  (lie  .EQ.  2)  THEN 
WRITE  (•,  6050) 

6050  FORMAT(20X, 'Enter  a  new  time  step  in  milliseconds.’) 

READ  (*.  *)  A3  (42) 

ELSE 

A3  (42)  =  DELTAT 
END  IF 
GOTO  1120 
1100  CONTINUE 
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WRITE  (*,  6060)  A1  (5) 

6060  FORMAT(//,10X,’The  PnessureAime  File:  ’,A20y. 
llOX.’does  not  exist,  check  the  file  name  and  try  again.’) 

PAUSE 
GO  TO  1090 

1120  CONTINIJE 
END  IF 

^  4c  *  «  *  4c  Ik  *  *  *  4i « III  4i  4c  %  *  *  *  *  «  «  *  4,**  *  *  «  4>  Diiti  41 *  41  *  *  4c «  *  4t  *  4c «  4c  4cit<  >l<  *  4<  4>  * 

^4>4c4i4i4c4c4i4i4c4c4c4c4c4i4c4<4c4i4i4c*  OPTION  2  IS  HANDLED  ***************************** 

Q  4i  4' 4<  4c  4c  4i  4<  4<  4i  4i  4c  4c  4c  4c  4c  4>  4i  4i  4>  4c  4>  4i  4>  4i  4i  4i  4i  *  4c  4i  4>  4i  4i  k  4c  4c  4>  4i  4i  4i  4i  4>  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  4i  4>  4i  4c  4c  4c  4c  4c  4i  4c  4<  4c  4<  4c 

IF  (TTYPE  .EQ.  2)  THEN 
CALL  CLEAR 
WRITE  (*,  6070) 

6070  FORMAT(//,10X, ’Enter  the  file  name  for  the  file  which  is  to’, 

1/,10X, ’contain  the  information  for  the  pressure-time’, 

2/,10X, ’generation.  The  file  is  to  have  no  extension,  but  all’, 

3/,10X,’DOS  path  conventions  are  applicable. ’7/) 

READ  (*,  5040)  FPVT 

5040  FORMAT(A20) 

A1  (5)  =  FPVT 
CALL  MKNAME  (Al) 

CALL  CLEAR 
WRITE  (•,  6080) 

6080  FORMAT(///,10X,’ln  order  to  generate  a  pressure  time  file’, 
l/,10X.'the  time  step  in  milliseconds  must  be  entered.  Enter’, 

2/,10X,’the  time  step.') 

READ  (*,  •)  A3  (42) 

END  IF 

^  4i  *  4i  4i  4i  4i  4i  4i  4c  4i  4' 4i  4i  4>  4i  4>  4i  4i  4i  41 4i  4i  •  4i  *  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  *  Ik  4i  4c  4i  4>  4c  4c  4c  4i  4>  4i  4>  4i  4i  4c  4i  4>  4i  4i  4i  4i  4i  Ik  4i  Ik  4i  4c  4c  4i  4i  4  4i  4i 

(;;4i4i4i4i4i4i*4i4i4i4i4i4i4i4c4i4i  INFORMATION  RLE  IS  OPENED  *******************4.*4c4.4i4.4i 

Q  4i  4i  4i  4i  *  4i  4i  4i  4c  4i  4i  4i  4i  4i  *  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4>  4  Ik  4i  k  « Ik  41 4c  4>  4i  4' 4i  4i  4  4i  4  4i  4i  4i  4i  4i  4i  4i  4i  4  4c  4c  4i  4<  4i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i 

OPEN  (UNIT  =  13,  FILE  =  Al  (4)) 

REWIND  (UNIT*  13) 

Q44444444i*44»4444444444444444444444444444444444444444444444444444444444 

^4444444444**44  SPECIAL  INFORMATION  FOR  THE  ETC  RRING  ***4*******4***< 

^**4*4444*4444***4*4*44444*4*4*444444444444444*44*44***4**444*444444*44 

IF  (ITYPE  .EQ.  5)  THEN 
CALL  CLEAR 
WRITE  (*,  6090) 

6090  FORMAT(//,I0X,’For  the  ETC  reduction  a  file  of  cumulative’, 

1/,I0X, 'electrical  energy  versus  time  is  required.  The  time’, 

2/,10X,'must  match  the  time  in  the  pressure-time  file,  the’, 

3/,10X,'units  are  seconds.  The  electrical  energy  is  in  units’, 

4/,10X.’of  megajoules.  Enter  the  file  name.’) 

READ  (*.  5050)  Al  (19) 

5050  FORMAT{A20) 

CALL  CXEAR 
WRITE  (*,  6100) 
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6I(X)  FORMAT!//. lOX, 'Enter  the  total  electrical  energy  input  in  MJ’) 
READ  (•.  •)  A3  (30) 

END  IF 


. . •*•••*•••••**•*•*•*•••**•••♦*•***** 

C**************  RLE  INFORMATION  IS  PROVIDED  TO  USER 


CALL  CLEAR 
WRITE  (•.  6110) 

6110  FORM AT(/'/.5X. 'The  following  file  names  will  be  used:') 

WRITE  (*.  6120)  A1  (3).  AI  (4) 

6120  FORMAT{5X. 'Master  File  :  '.A20.’  Created  in  Option  1’, 

1/,SX. 'Information  File  :  'w^20,'  Created  Now  in  Option  4’) 

IF  (ITYPE  NE.  2)  THEN 
WRITE  (*.  6130)  Al  (3).  Al  (14) 

6130  FORMAT(5X.'Pressure/rimc  File:  ’.A20,'  Created  in  Option  3', 
I/.SX. 'Smoothed  Data  File:  ',A20,'  Created  in  Option  S’) 

END  IF 

WRITE  (•.  6140)  Al  (10).  Al  (17) 

6140  FORMAT(5X. 'Output  File  :  ’.A20.’  Created  in  Option  6’. 
l/.SX. 'Graphics  File  :  ’.A20.’  Created  in  Option  6’) 

IF  ((ITYPE  EQ.  1)  OR.  (ITYPE  EQ.  4)  OR.  (ITYPE  EQ.  5))  THEN 
WRITE  (*.  6150)  Al  (18) 

6150  FORMAT(5X.’Bum  Rate  File  :  ’.A20.’  Created  in  Option  6’) 

END  IF 

IF  (ITYPE  EQ  5)  THEN 
WRITE  (*.6160)  Al  (19) 

6160  FORMAT(5X.’ElectricaI  Energy  :  ’.A20.’  Used  in  Option  6’) 

END  IF 
PAUSE 


. . BOMB.  PROP  &  IGNITER  INFO  IS  OBTAINED  ***••***•*••*•*•♦ 

. . ************ . . 

CALL  CLEAR 

WRITE  (•.  •)  ’  Bomb  Information' 

WRITE  (•.  •) 

WRITE  (*.  •)  'Enter  the  bomb  volume  (cc):  ’ 

READ  (•.  •)  A3  (23) 

WRITE  (•.  •) 

WRITE  (•.  •)  'Enter  the  initial  temperature  of 
WRITE  (•.  •)  'the  bomb  in  degrees  Kelvin.’ 

WRITE  (•.  •)  'Several  common  temperatures  are:’ 

WRITE  (•.•)'  ■25F-241K’ 

WRITE  (*.  •)  ’  -20  F  «  244  K’ 

WRITE  (•.  •)  '  70  F  =  294  K’ 

WRITE  (•.  •)  ’  120  F  -  322  K' 

WRITE  (•.  •) 

WRITE  (•,  •)  'Plca.se  Enter  Your  Choice:  ’ 

READ  (•.  •)  A3  (24) 
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nnnn 


IF  (iryPE  .EQ.  4)  THEN 
A1  (16)  =  Tntemipted  Burner’ 
ELSE 

A1  (16)  =  'aosed  Chamber’ 
END  IF 


(^*«*«*««********4.4.  propellant  and  igniter  information  is  ENTERED  ******* 


CALL  CLEAR 


WRITE  (*,  *) 

WRITE  (*,  *)  ’  Propellant  and  Igniter  Information’ 
WRITE  (*.  *) 

WRITE  (*,  *)  ’Enter  the  mass  of  the  propellant  in  grams:  ’ 
READ  (*.  *)  A3  (25) 

A3  (46)  =  A3  (25)/A3  (3) 

CALL  CLEAR 


WRITE  (*.  *) 

WRITE  (*,  *)  ’Enter  the  mass  of  the  igniter  in  grams:  ’ 
READ  (*.  *)  A3  (26) 

CALL  CLEAR 


WRITE  (*.  *) 

WRITE  (*,  *)  ’Enter  the  initial  temperature  of 
WRITE  (*,  *)  ’the  propellant  in  degrees  Kelvin.’ 
WRITE  (*,  *)  ’Several  common  temperatures  are:’ 
WRITE  (*.  *)  ’  .25  F  =  241  K’ 

WRITE  (*,  *)  ’  -20  F  =  244  K’ 

WRITE  (*.  *)  •  70  F  *  294  K’ 

WRITE  (*.  •)  ’  120  F  =  322  K’ 

WRITE  (*.  *) 

WRITE  (*,  *)  ’Please  Enter  Your  Choice:  ' 

READ  (*,  *)  A3  (27) 

WRITE  (*.  *) 

WRITE  (*,  •)  ’Enter  the  initial  temperature  oP 
WRITE  (*,  *)  ’the  igniter  in  degrees  Kelvin.  ’ 
WRITE  (*.  *) 

WRITE  (*,  *)  ’nease  Enter  Your  Choice:  ’ 

READ  (*.  *)  A3  (28) 


SPEQAL  INFORMATION  FOR  THE  ************************* 
‘**  REDUCTIONS  IS  OBTAINED  *************************** 


IF  (OTYPE  .EQ.  2)  .OR.  (TTYPE  .EQ.  3))  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’Enter  the  method  by  which  the  burn  rate’ 
WRITE  (*,  *)  ’information  will  be  entered.’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’  1.  bPNi  bum  rate  law,  one  law  for  each  layer’ 
WRITE  (*.  *) '  2.  Table  of  pressure  versus  rate.’ 
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WRITE  (*.  *)  ’  ’ 

1130  CONTINUE 

WRITE  (*.  *)  ’Enter  your  choice  by  number  (1-2).’ 

WRITE  (*.  •)  ’  ’ 

READ  (*,  *)  ICHOICE 
IF  (ICHOICE  .GT.  2)  THEN 

WRITE  (*,  *)  ’Your  choice  is  not  a  1  or  a  2.  Please  select  again.’ 
GOTO  1130 
END  IF 

IF  (ICHOICE  .EQ.  1)  THEN 
CALL  CLEAR 
N  =  INT  (A3  (4)  +  .5) 

WRITE  (*,  6170)  N 

6170  FORMAT(///,10X,’The  grain  has  ’.12,’  layers.  One  bum  rate  per’ 
ly.lOX, ’layer  is  required.’//) 

A3  (5)  =  -  1*N 
NEND  =  48  +  2*N 
JNUM  =  1 

DO  1140  J  =  50.  NEND.  2 
WRITE  (*,  6180)  JNUM 

6180  FORMAT(’  ’.’Enter  the  coefficient  of  the  bum  rate  law;  layer;  ’,  12) 
WRITE  (*.  *)  ’  ’ 

READ  (*,  *)  A3  (J) 

WRITE  (•,  6190)  JNUM 

6190  FORMAT(’  ’.’Enter  the  exponent  of  the  bum  rate  law  layer:  ’,12) 
WRITE.  (♦.  *)  ’  ’ 

READ  (*.  *)  A3  (J  +  1) 

JNUM  =  JNUM  +  1 
1140  CONTINUE 
END  IF 

IF  (ICHOICE  .EQ.  2)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’How  many  points  will  be  used  ’ 

WRITE  (*,  *)  ’to  describe  the  burning  rate?’ 

WRITE  (*,  *)  ’Maximum  of  20  points.’ 

WRITE  (*,  ♦)  ’  ’ 

READ  (*.  •)  NP 
A3  (5)  =  NP 
DO  11501  =  1,NP 
WRITE  (*,  6200)  I 

6200  FORMAT(5X, ’Enter  the  pressure  and  rate  for  point  ’,12,’,’, 
lASX.’both  on  the  same  line.’) 

JJ  =  49  +  I 
KK  =  79  +  I 

READ  (*.  •)  A3  (JJ).  A3  (KK) 

1150  CONTINUE 
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END  IF 
END  IF 

^  «i  «<■  4>  ***  4<  ^i*****  4>  ******  <1  *  41  *  4i  *  <ii»  41  >t>  *«>  <tt  *  4i  4>  *  4> «  4>  >•>>•>««  ik  **  4>  *  *4i  **41  >l<  4>  i|<  *  41*  i|<  * 

Q**************  predefined  burn  rate  ranges  are  derned  *************** 
^********************************************************************** 

IF  (GTYPE  .EQ.  1)  .OR.  (TTYPE  .EQ.  4)  .OR.  (ITYPE  .EQ.  5))  THEN 
CALL  CLEAR 
WRITE  (*,  6210)  PMAX 

6210  FORMAT(//,10X,’One  output  of  the  bum  rate  analysis  is  a  series’, 
l/.lOX.’of  bP^n  bum  rate  laws.  The  program  has  the  option  to’, 

2/,10X,’determine  the  bum  rate  laws  for  any  given  pressure  range’, 

3/,10X,’up  to  the  maximum  pressure  for  the  firing:  ’  J^S.O) 

OPEN  (UNIT  =  7.  FILE  =  A1  (18)) 

WRITE  (*,  6220) 

6220  FORMAT(//,10X, ’Three  preset  ranges  can  be  used:’ 
iy,30X,*5  -  10%’y,30X,’10  -  25%’y,30X.’25  -  75%’, 

2//,10X,’l,  Use  predetermined  ranges’, 

3/,10X,’2.  Enter  new  ranges.’y/,10X,’Enter  your  choice.’) 

READ  (*,  *)  lie 
DUMMY  =  0.0 
IF  (lie  .EQ.  1)  THEN 
N  =  3 

WRITE  (7,  *)  N 
WRITE  (7,  *)  .05*PMAX 
WRD’E  (7,  *)  .1*PMAX 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  ♦)  DUMMY 
WRITE  (7,  *)  .1*PMAX 
WRITE  (7,  *)  .25*PMAX 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  .25*PMAX 
WRITE  (7,  *)  .75*PMAX 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  DUMMY 
WRITE  (7,  *)  DUMMY 
ELSE 

CALL  CLEAR 

WRITE  (*,  *)  ’Enter  the  number  of  ranges’ 

READ  (*,  *)  N 
WRITE  (7,  *)  N 
DO  1160  III  =  1,N 

WRITE  (*,  *)  ’Enter  pressures  in  MPa  for  range:  ’,  III 
READ  (*,  *)  X,  Y 
WRITE  (7,  *)  X 
WRITE  (7.  *)  Y 
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WRITE  (7.  *)  DUMMY 
WRITE  (7.  *)  DUMMY 
WRITE  (7.  •)  DUMMY 
1160  CONTINUE 
END  IF 

CLOSE  (UNIT  =  7) 

END  IF 

^  « Id  *  4i  *  «  *  *  *  «  *  *  *  *  *  *  «  *  itiiliKiili  <■  4t «  *  *  V  «  *  *  *41  *  *  *  *  «  «  *  4t « ■)>  411)1  *41  *  HiKiili  *  «  m  it<  4< «  4«(<  *  «  *  >l«ti  *  *  * 

^4<4i4<4>4i4<4>4<4>4i4<4i4<4i  INFORMATION  FILE  IS  WRITTEN  *************************** 

Qt***********************************’¥********************************* 

1170  CONTINUE 
DO  11801=  1,6 
WRITE  (13.  6230)  A2  0) 

6230  FORMAT(A80) 

1180  CONTINUE 
DO  11901=  1,20 
WRITE  (13,  6240)  A1  (I) 

6240  FORMAT(A20) 

1190  CONTINUE 
DO  1200  I  =  1.  100 
WRITE  (13.  *)  A3  (I) 

1200  CONTINUE 
DO  12101=  1,  11 
DO  1220  J  =  1,  15 
DO  1230  K=  1.  5 
WRITE  (13.  *)  P  (I,  J,  K) 

1230  CONTINUE 
1220  CONTINUE 
1210  CONTINUE 

CLOSE  (UNIT=  13) 

END 

^4<  4<  4i  4i  4<  4<  4i  4>  4<  4>**4<  4>*4i*4i  4i  4<  4i  4i  4>  4<  4i  4<  4i  4>4<4i4<4>4i*****4i4i4<**4>4i  4<4<4<4<4<4<  41 4' 41 4>  41**41 4>  4c  4i4>4<4>  41 4>4>4<4<* 

^********************  SUBROUTINE  CLEAR  4'4"*"*<*4<*************************** 
^*********************************************************************** 
SUBROUTINE  CLEAR 
CHARACTER  ST*4 
DATA  ST/’  [2J’/ 

WRITE  (*,  6000)  ST 
6000  FORMAT  (1X.A4) 

RETURN 

END 

^*********************************************************************** 
^*********************  SUBROUTINE  MKNAME 
^*************************«********************************************* 


SUBROUTINE  MKNAME  (Al) 
CHARACTER*20  Al  (20),  A*l,  NAMEl 
NAMEl  =  Al  (5) 

1000  CONTINUE 
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DO  1010  I  =  1.  17 
A  =  NAMEl  0:1) 

IF  (A  .EQ.  THEN 
CALL  CLEAR 

WRITE  (♦,  *)  ’Tlie  file  name  entered  has  an  extension  which  is’ 
WRITE  (*,  *)  ’not  allowed.  Please  enter  a  new  name  without  ’ 
WRITE  (*,  *)  ’an  extension.’ 

READ  (*.  5000)  NAMEl 

5000  FOR.MAT(A20) 

GO  TO  1000 
END  IF 

IF  (A  .EQ.  ’  ’)  THEN 
NAMEl  (1:1  +  3)  =  ’.pvt’ 

A1  (5)  =  NAMEl 
NAMEl  (1:1  +  3)  =  ’.inf 
A1  (4)  =  NAMEl 
NAMEl  (1:1  +  3)  =  ’.pdf 
A1  (14)  =  NAMEl 
NAMEl  (1:1  +  3)  =  ’.out’ 

A1  (10)  =  NAMEl 
NAMEl  (1:1  +  3)  =  ’.daf 
A1  (17)  =  NAMEl 
NAMEl  (1:1  +  3)  =  ’.hr’ 

A1  (18)  =  NAMEl 
GO  TO  1020 
END  IF 

1010  CONTINUE 
CALL  CLEAR 

WRITE  (*,  *)  ’FILE  NAME  TOO  LONG  TO  CREATE  OTHER  HLES’ 

PAUSE 

STOP 

1020  CONTINUE 
RETURN 
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APPENDIX  J: 

LISTING  -  PROGRAM  MKSMOOTH.FOR 
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Intentionally  left  blank. 
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PRCX3RAM  MKSMOOTH 

^  4i4i4i *414141 41* 4ii|i4ii(i4i4<4i4>4>4>4i*4iitiitiiti4ii|i4>4t4ii|i4i4ii|i4i«4ii|,4iiti4c«4r«4i«i|>it<i|<4> III* *41 4. 4i«4(*iti4i4i*4i4iiti4c 
^***** 

C  Version:  3.0,  January  1992;  Last  Modified  1/7/92 
C  1/9/92 

C  2/10/92;  GRAPHICS  ADDED 

C 

C  Written  by:  William  Oberle,  U.S.  Army  Research  Laboratory 
C 

C  Purpose:  This  program  prepares  data  by  removing  wild  points,  smoothing 
C  the  data,  calculating  the  derivative. 

Q  ********************************************************************** 
^****** 

COMMON  /CNTROU  ILENGT.  NS.  NE 

COMMON  /GRAPH/  STARTl,  START2,  DELTAl,  DELTA2 

CHARACTER*20  FPVT.  FPDT,  HNF,  A1  (20),  A2  (6)*80,  NAMEl,  A*1 

CHARACTER*20  XAXISL,  YAXISL,  TITLE*40 

DIMENSION  T  (2048),  PR  (2048),  PS  (2048),  PDOT 

1  (2048),  A3  (100),  P  (11,  15.5) 

2  ,  EE  (2048),  ORGP  (2048),  ORGPl  (2048) 
^*********************************************************************** 


(^******************  OBTAIN  PRINTER  &  SCREEN  CHARACTERISTICS  ************ 

0<t<**>l«t>***>t'**>|i**<t<*<»4<*4>*>l<*************************<l>**********><i%*********** 


CALL  CLEAR 
WRITE  (•,  6000) 

6000  FORMAT(//,10X,’This  program  has  the  capability  of  generating’, 
l/,10X,’hard  copy  plots  of  the  pressure-bum  rate  data.  To’, 

2/, lOX, ’generate  plots  information  concerning  your  printer  is’, 
3/,10X, ’required.  The  output  port  is  assumed  to  be  LPTl.’, 

4//,  1  OX, ’Select  printer  by  number.’, 

5/,15X,’l.  Epson  Dot  Matrix’, 

6/,15X,’2.  HP  Laser  Jet  ’y/,10X,’Enlcr  Choice.’) 

READ  (*,  *)  NAIS 
IF  (NAIS  .EQ.  1)  THEN 
MODEL  =  5 
ELSE 

MODEL  =  62 
END  IF 


^********************************************************************** 
(^********»*******  CONTROL  FOR  DOING  ANOTHER  SMOOTHING  ***************** 

^4>4i*4'*<|i*4i4i4<*4i4i*4>*4i4i>t>4i*4r4i4i*4i4i4i*4i4i4i4i4r4i4i**4i4i4i4i4i*4>4i4i4i4i4>4>4i4i*4i4i4i4i4i*4>4>4<4i*«4i4i*4i 

IPLCH  =  0 

C************<»*********i|i*<'********<l'4'<l>**'t'**4<**4>4>4i4i4i4>*4i*4i4i4>*4i4>4<4>4<4>4i4>4<4<4i4i4i 

^4>4i4>4>4i4i**4>4i4>4i4>«**4^***  {g  REQUESTED  ************************** 

C*********************************4>********4>*«***4>>l<4'*4"t<*****<li4><l>4'4>4<4<4>4i*4i 

CALL  CLEAR 
1000  CONTINUE 
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WRITE  (•,  6010) 

6010  FORMAT(/////^OX, ’Enter  file  name  for  data  to  be  reduced. ’y/) 
READ  (*.  5000)  HNF 
NAMEl  =  FINE 
1010  CONTINUE 
DO  10201  =  1,  17 
A  =  NAMEl  a:I) 

IF  (A  .EQ.  ’.’)  THEN 
CALL  CLEAR 


WRITE  (*,  *)  ’The  file  name  entered  has  an  extension  which  is’ 

WRITE  (*,  *)  ’not  allowed.  Please  enter  a  new  name  without  ’ 

WRITE  (*,  *)  ’an  extension.’ 

READ  (*.  5000)  NAMEl 
GO  TO  1010 
END  IF 

IF  (A  .EQ.  ’  ’)  THEN 
NAMEl  (1:1  +  3)  =  ’.inf 
FINF  =  NAMEl 
GO  TO  1030 
END  IF 

1020  CONTINUE 
5000  FORMAT(A20) 

1030  CONTINUE 

OPEN  (UNIT  =  9.  FILE  =  FINF.  STATUS  =  ’OLD’,  ERR  =  1040) 

REWIND  (UNIT  =  9) 

^  itiili  i(i  *  1)1 4r  *  Di  *  4i  i|>  III  *  If  *  41  *  « Ik  *  4>  *  *  «  *  %  41  *  4i  *  *  *  «  *  4> «  *  4>  3|i  Hiiti  *  i<i  41  *  i|>  *  i|i «  *  *  *  41 4>  *  4i « 


^4i4i4i4i4i4i4i4<4i4i4i4i4i4i4c4i4i4i4i4i4i4i4i  READING  .INF  FILE  ***************************** 

^  4i  4i  4<  4i  4<  4i  4i  4i  4i  4(  4i  4<  4i  4i  4i  4i  4<  k  4i  4i  4i  4i  4i  4<  4i  4i  41 4i  4<  k  4i  4<  4i  4i  A  4>  4i  4<  4i  4i  4i  4i  4i  4i  41 41 4i  4>  4i  4i  4i  4i  4>  4i  41 41 41 4i  4i  4i  4i  4i  4i  4i  4i  4<  4>  4i  4i  4i  4i 


DO  10501  =  1,  6 
READ  (9.  5010)  A2  (I) 

1050  CONTINUE 
5010  FORMAT(A80) 

DO  1060  I  =  I,  20 
READ  (9.  5020)  A1  (I) 

1060  CONTINUE 
5020  FORMAT(A20) 

DO  1070  I  =  1.  100 
READ  (9.  *)  A3  (I) 

1070  CONTINUE 
DO  1080  I  =  1,  11 
DO  1090  J  =  1,  15 
DO  1100K=  1.5 
READ  (9.  *)  P  a.  J.  K) 
1100  CONTINUE 
1090  CONTINUE 
1080  CONTINUE 
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CLOSE  (UNIT  =  9) 
GOTO  1110 
1040  CONTINUE 

WRITE  (*.  6020)  FINE 


6020  FORMAT(//,10X,’An  error  has  occurred  in  opening  the  file,’,A20, 
l/,10X,’most  likely  the  file  does  not  exist.’) 

PAUSE 
GO  TO  1000 

^  *  41  4i  *  «  4i  *  *  «  *  4i  4ii|iiti  Hi  Id  4>  4i «  «  *  *  «  *  Ik  4i «  4i  «*  «  *  *  «  «  *  *  «  4ii|i «  4t  III  4i  Hi  4i  itc  *  4c «  4i  *  *  *  « ifiitiiti  4ntc  *  *  4r  i)i  *  1)1 «  4t « 

(^4i4<*4>*4i4>*4i4i4i***4«i4i4<4>*  SMOOTHING  OPTIONS  ARE  LISTED  ********************* 

^  4c  4>  4i  4i  4c  4i  4i  41 4i  4i  *  *  *  *  *  Id  4i  <d  4i  4i  4i  4i  41 41 4i  4i  4i  4i  4i  *  4c  4c  4i  4c  Id  4i  4t  41 4i  4c  *  4c  4i  4i  4i  *  *  4i  4c  4c  Id  4c  4i  4c  *  4i  4i  4i  4c  *  4c  Id  4c  Id  4<  4<  4c  4c  Id  4i  4> 


1110  CONTINUE 
CALL  CLEAR 
WRITE  (*.  6030) 

6030  FORMAT(////,15X,’  Smoothing  &  Differentiation  Options’, 
l/,5X,’l.  Use  a  fixed  bridge  length  (slivering  not  considered) ’y, 
25X,’2.  Use  a  "floating"  bridge  length  (slivering  not  considered)’ 
3y,5X,’3.  Use  a  fixed  bridge  length  (slivering  considered)’ 
4y,5X,’4.  Use  a  floating  bridge  length  (slivering  considered)’ 
5y,5X.’5.  Exit’ 

6y/,15X,’Please  Enter  Your  Choice:  ’) 

READ  (*.  *)  ICHOICE 
IF  (ICHOICE  .EQ.  5)  GO  TO  1120 
IF  aCHOICE  .GT.  5)  THEN 
WRITE  (*,  *)  ’Your  choice  is  not  between  a  1  and  5’ 

PAUSE 
GOTO  1110 
END  IF 


^  4i  4c  4i  4i  4i  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  Id  4c  4c  Id  4c  4c  4c  4c  41 4c  4c  4c  4c  4c  4c  Id  4i  4c  4c  4c  Id  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4i  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


C4c4cd*4c«4c4cidid4c.d4c4c  CONTROLS  ON  HANDLING  DATA  ARE  ENTERED  ***************** 

^  4c  4c  4c  4c  4c  4i  4c  cd  4i  4i  4c  4c  4c  4c  Id  4c  4i  4c  cd  4c  4c  4i  4i  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  Id  4c  Id  4c  4c  4c  cd  4c  4c  4c  4c  4i  d  4c  4c  4c  4c  Id  Id  cd  4c  4c  4c  4c 


CALL  CLEAR 
WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’Enter  the  number  of  wild  point  removal  passes:  ’ 
READ  (*,  *)  NUMW 
IF  (NUMW  .GT.  0)  THEN 

WRITE  (*,  *)  ’This  program  allows  the  user  to  enter  a  value’ 
WRITE  (*,  *)  ’to  determine  what  the  cutoff  will  be  for’ 

WRITE  (*,  *)  ’discarding  or  keeping  wildpoints  or  outliers.’ 
WRITE  (*,  *)  ’The  value  entered  can  be  any  number  greater  than’ 
WRITE  (*,  *)  ’zero.  The  closer  to  zero,  the  tighter  the’ 

WRITE  (*,  *)  ’tolerance  on  the  wildpoints.’ 

WRITE  (*,  *)  ’  ’ 

1130  CONTINUE 


WRITE  (*,  •)  'Enter  the  value  for  the  tolerance  on  the  wildpoints.’ 
WRITE  (*,  •)  ’A  value  of  5  is  generally  used.’ 

READ  (*,  *)  XWP 
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IF  (XWP  .LE.  0,0)  THEN 

WRITE  (*,  *)  ’VALUE  OUl'  OF  RANGE.  MUST  BE  LARGER  THAN  ZERO’ 
PAUSE 
GOTO  1130 
END  IF 
END  IF 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  •)  ’Enter  the  number  of  smoothing  passes:  ’ 

READ  (*.  *)  NUMS 
IF  (NUMS  .LE.  0)  GO  TO  1140 
ILENGT  =  -  1 

IF  (aCHOICE  .EQ.  1)  .OR.  OCHOICE  .EQ.  3))  THEN 
1150  CONTINUE 
WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’Enter  the  fixed  bridge  length,  a  odd  number’ 

WRITE  (*,  *)  ’between  5  and  35.’ 

READ  (*,  *)  ILENGT 

4. 4>4i  41  <1 4.*****,),  4,4,,),  4, 4, 4, 4, 4, 4,^4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,4, 

C4.*4.*4.*4i*4.4.**4.*4.4i4.  TEST  TO  DETERMINE  IF  ILENGT  IS  OK  ****************** 
Q***4i**4i4>*4<**4i*4"4<4i4i4i4<*4i4>4i***4i4i*4i*4i**4i4<4'4>**4i4i*4i4i4t4i***4"**4i4t4t4i4i4i4>4"*4i4<4>4<4t4i4t 

IFHRY  =  MOD  (ILENGT.  2) 

IF  ((IFHRY  .EQ.  0)  .OR.  (ILENGT  .GT.  35)  .OR.  (ILENGT  .LT.  5))  THEN 
WRITE  (*,  *)  ’The  bridge  length  is  not  an  odd  number  between’ 

WRITE  (*,  *)  ’5  and  35.  Please  enter  a  new  number  for  the  bridge’ 

WRITE  (*,  •)  ’length.’ 

GOTO  1150 
END  IF 
END  IF 

IF  OCHOICE  .GE.  3)  THEN 
CALL  CLEAR 
WRITE  (*,  6040) 

6040  FORMAT(////,20X, 'Please  enter  the  slivering  pressure  in  MPa.’) 

READ  (*,  *)  PCUT 
END  IF 

(;;«4r4<**4<*4<*********4<4i4i4i4-4-4>**4<**4>***4>*****4>**4t4i**4i4-4i4-4.4i4>4i**4i***4-**4i4i4i4r4.4i4.4i4i 
^4.4>4.4<4<***4<****4i  SWITCH  TO  SKIP  IF  REDOING  SMOOTHING  ******************** 
(^*4.*4<4i*4<*****4i4i**4i4i4i4i*4r**4i4>**4.4-4.*4.********4i4.***4r4.4i*4-*4-*4<***4.***4i4i4i4i4i4.4i4<4i 

IF  OPLCH  .EQ.  1)  GO  TO  1160 

C4i4i4i*4.4i*4i4i4.4.4i*4i4i4i*4i4i*4i4i4.**4i**4r4r4.**4.4i**4.4i*4i4i4i*4i***4.****4i4.**4>**4i***4<***4i** 
(^4i*4>***4i4>4t4>4i4r4i**4t4r4i***  -pHE  .PVT  FILE  IS  READ  *************************** 
Q**4t*4i***4i4>**4>******4i4r4>******4i**4r4r4i*4.4>*4i**4i*4i4i*******4i**4i4i4.****4.4i4'*****4i 

1140  CONTINUE 
FPVT  *  A1  (5) 

OPEN  (UNIT  =  15.  FILE  *  FPVT) 

REWIND  (15) 
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n  n  n 


READ  (15.  *)  NP 
IF  (N?  .GT.  2048)  THEN 
CALL  CLEAR 

WRITE  (*.  •)  ‘THERE  ARE  TOO  MANY  POINTS  IN  THE  P/T  DATA  RLE’ 
WRITE  (*,  *)  ‘A  MAXIMUM  OF  2048  POINTS  ALLOWED’ 

PAUSE 
STOP 
END  IF 

READ  (15.  *)  PMAX 

A3  (43)  =  PMAX 

READ  (15.  •)  PMIN 

READ  (15.  *)  TMAX 

READ  (15.  *)  TMIN 

DELTAT  =  (TMAX  -  TMIN)/(NP  -  1) 


Q^,*^.m*************^,  OBTAINING  CONSTANTS  FOR  GRAPHS  ********************* 


T  (1)  =  0.0 
T  (2)  =  TMAX 
CALL  SCALE  (T.  5.00.  2.  1) 
STARTl  =  T  (3) 

DELTAl  =  T  (4) 

T  (1)  =  0.0 
T  (2)  =  PMAX 
CALL  SCALE  (T.  5.00.  2.  1) 
START2  »  T  (3) 

DELTA2  =  T  (4) 


^**4ii|iitt**iti4i*********i(i*i|i4i*ik«r*»*««t*4i«t*«**4i*4i4>i|>«i«t***«i****«riti*»»*«i4i***i»*4i*4ii|>*» 

TIME  STEP  IS  CONFIRMED  '•■******•*•**'•'*•***•**•*•******* 


CALL  CLEAR 
WRITE  (•.  6050)  A3  (42) 

6050  FORM AT(////.20X. ‘The  current  time  step  is:’.F10.6.’  ms’. 
l//.20X.’Is  this  value  correct?  (Ycs=l,  No=2)’. 

2/.20X,’Enter  your  choice.’) 

READ  (*.  *)  III 
IF  (III  .EQ.  2)  THEN 
WRITE  (*.  6060) 

6060  FORMAT(/,20X.’Enter  correct  time  step  in  milliseconds.') 
READ  (*.  •)  A3  (42) 

DELTAT  =  A3  (42)/1000. 

END  IF 


PRESSURE-’HME  RLE  IS  READ 


1170  CONTINUE 
DO  11801  =  l.NP 

READ  (15.  *.  ERR  =  1 190)  T  (I).  PR  (I) 
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1180  CONTINUE 
CLOSE  (15) 

GO  TO  1200 

1190  CONTINUE 
WRITE  (*.  6070)  I 

6070  FORMAT(/^X,’AN  ERROR  HAS  OCCURRED  IN  READING  THE  PRESSURE’, 
lASX.’AND  TIME  FILE.  THE  ERROR  OCCURRED  ON  THE  ’,14,’  STEP.’, 
2/,5X,’CHF,CK  THE  DATA  HLE  AND  TRY  AGAIN.’) 

PAUSE 

STOP 

1200  CONTINUE 


^  «  *  *  *  *  Di  *  «  *  Hi  *  *  *  *  *  IK  Hiiti «  *  *  *  *  *  *  «  *  4c  m  «  Dc  it<  4c  4. 4. 4, 4i  4<  <>  <«<  *  4<  *  >t"|i  4c  «><•>  *  <•  *  >t> «  «  «>•> « 


C***  THE  ELECTRICAL  ENERGY  IS  READ  IF  OPTION  5,  ETC  HAS  BEEN  ♦♦♦****♦*** 

^4>4>4c4>*4>*4t4ciK*4i4c*4<4i4c4c4c4c4'4c4c4c4c4c  SELECTED  4«<'>l"(<4>4"l>4'4c4'4c4c4<4c4c4i4c4i4c4c4c4c4i4>4c4'4c4>4<4<4c4c4c4c4< 

^  iK  4c  *  4i  4iiK  4c  4c  4c  *  4c  4c  4c  4c  4i  4i  4c  4<  4c  4>  4c  4c  4>  4c  4c  4c  IK  4c  4c  4<  4c  4<  4c  4>  4c  4c  4c  4c  4c  4c  4>  4t  4>  K  4c  4i  4c  4c  4c  4c  K  4c  4c  4>  41 4>  4c  4c  4c  41 4c  4c  4c  4>  4c  4<  4>  4>  4>  4>  4c 


ITYPE  =  INT  (A3  (2)  +  .5) 

IF  (ITYPE  .EQ.  5)  THEN 
OPEN  (UNIT  =  15,  FILE  =  A1  (19)) 
DO  12101=  l.NP 
READ  (15,  *)  DUMTT,  DUMEE 
EE  a)  =  DUMEE 
1210  CONTINUE 
END  IF 


^  4c  4c  4c  4c  4c  4c  4c  4c  41 4c  4c  4c  4i  4c  4c  *  4c  4c  *  4c  4c  4c  4i  4i  4c  4c  4c  4c  4c  4  4  4c  4c  4i  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c 

(^4c4c44c4.4c4*4.*44c****4c*  GRAPH  OF  PRESSURE  TIME  IS  ALLOWED  *******•*••**•**** 

^4c4c4i4c4c4c44c4c4i4c4c4c4i*4c4c4c4c**4c4i*«4i4i4i4i4i*4c4i4i**4i4c4c4c*4c*4c4c4ciK4ciK4c4ciK44c4c4c4c4c44c4c4c4c4c4c4c4i*4c4c4c 

DO  12201  =  1,2048 
ORGPl  (I)  =  PR  (I) 

1220  CONTINUE 
CALL  CLEAR 

WRITE  (*,  *)  ’1.  Plot  original  prcssurc-iimc  data’ 

WRITE  (•.  •)  ’2.  No  plot’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’Enter  your  choice  (1  -  2)’ 

READ  (*,  •)  lYR 

IF  OYR  .EQ.  2)  GO  TO  1230 

XAXISL  =  Time  (See)’ 

YAXISL  =  'Pressure  (MPa)’ 

TITLE  =  ’Press  Vs  Time;  File: ’//A  1  (5) 

CALL  PL88LG  (T,  ORGPl.  NP,  XAXISL.  YAXISL.  TITLE,  MODEL) 

1230  CONTINUE 

. . . . . 

C***  THE  INITIAL  PRESSURE  TO  KEEP  IS  DETERMINED.  MAX  IGNITER  PRESSURE 
(^444444444444  ^ND  THEORETICAL  MAX  PRESSURE  IS  DETERMINED  ****44444444444 

. . 44444444444444444444444444444444444 . 444444 

CALL  PIG  (PIGN,  A3.  P) 

. . 4444444444444444444444444*444444444444444 

(^44444444*444444  pjRST  WILDPOINTS  ARE  REMOVED  ************************** 
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u  u  u  u  u 


1160  CONTINUE 

IF  (NUMW  EQ.  0)  GO  TO  1240 
DO  1250  I  =  1.  NUMW 
CALL  CLEAR 
WRITE  (•.  6080)  I.  NUMW 

6080  FORMAT(////  ’.’PROCESSING:  Wildpoint  Pass  ’.12.’  of  ’.12.’.’) 

CALL  CBWILDPT  (PR.  NP.  NUMW.  XWP) 

1250  CONTINUE 
1260  CONTINUE 
CALL  CLEAR 

WRITE  (*.  •)  ’1.  Plot  original  data’ 

WRITE  (*.  *)  ’2.  Plot  wildpointcd  dau’ 

WRITE  (*.  •)  ’3.  Oveiplot  original  &.  wildpointed’ 

WRITE  (*.  *)  ’4.  No  plot,  proceed  with  program’ 

WRITE  (*.  •)  ’  ’ 

WRITE  (•.  •)  ’Enter  your  choice  (1  -  4)’ 

READ  (*.  *)  lYR 

IF  (lYR  EQ.  4)  GO  TO  1270 

XAXISL  =  Time  (Sec)* 

YAXISL  =  Pressure  (MPa)* 

TITLE  *  ’Press  Vs  Time;  Filc:’//Al  (14) 

C  nTLE* 'Pressure  Versus  Time’ 

IF  (lYR  EQ.  1)  THEN 

CALL  PL88LG  (T.  ORGPl.  NP.  XAXISL.  YAXISL.  TITLE.  MODEL) 
END  IF 

IF  (lYR  EQ.  2)  THEN 

CALL  PL88LG  (T.  PR.  NP.  XAXISL.  YAXISL.  TITLE.  MODEL) 

END  IF 

IF  (lYR  EQ.  3)  THEN 

CALL  PL880P  (T.  ORGPl.  PR.  NP.  XAXISL.  YAXISL.  TITLE.  MODEL) 
END  IF 
GO  TO  1260 
1270  CONTINUE 


PRESSURE  DATA  IS  REDUCED  ****************************** 


RNDING  LOCATION  OF  PMAX 

. . *•*••*••*••****•••**•*******, 

1240  CONTINUE 
PMAX*  PR  (I) 

NHIGH  «  I 
DO  1280  I  *  l.NP 
IF  (PR  a)  GE.  PMAX)  THEN 
PMAX  «  PR  (I) 

NHIGH  *  I 
END  IF 
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1280  CONTINUE 

Q  *  *  *  *  *  « III  *  »  *  <1  *  *  »  *  4i  *  III  *  «  4i  4i « 4i «  4i «  4t «  *  4i  4ii»  *  Hi «  4i4i  *  4i  4i  4i  *  *1). «  *  4i  4i «  4i  4i  4ii|i  4i  4i  41 4i4i  4i  4,  *  4i « 

C*********  NEXT  HND  LOCATION  WHERE  ALL  POINTS  ARE  ABOVE  *************** 
^**4i4i4i*4i***««***4i4i«4i4i«i  gQgj,  OF  THE  IGNITER  PRESSURE  ****••**•♦*********♦«■ 

^4i4i4i4i*4i4i4i*4i4i4ii4*««4i*4i4i*4iiti4ii|i«i*«i4i«*4i4i*4i4i4i4i4i*4i**4i**4i4i4ii|i4i4i4i4i4i4i  41  *141414141 1114141*111414141* 

NSN  =  0 

DO  12901  =  l.NHIGH 
IF  (PR  0)  LT.  PIGN)  NSN  =  1+1 
1290  CONTINUE 
LOWERI  =  NSN 

IF  (LOWERI  .LE.  0)  LOWERI  =  1 


^*********************************************************************** 
^****************  ]^>VKrnNG  THE  ARRAY  ■)'****'******'<"*4"t"*"<"*"<"t'*4"i"i>*4'*******t' 
^*********************************************************************** 


CALL  CLEAR 

PIG2  =  PIGN/.8 

NDIFF  =  NHIGH  -  LOWERI 

IF  (NDIFF  .GT.  1000)  LOWERI  =  NHIGH  -  999 

WRITE  (*.  6090)  PIG2 

6090  FORMATC  ’.’The  pressure  due  to  the  igniter  is;  ’,F12.3,’MPa’) 
WRITE  (*.  6100)  PR  (LOWERI) 

6100  FORMATC  ’.’The  starting  pressure  value  is:  ’4^12.3,’  MPa’) 
NPOINTS  =  LOWERI  -  1 
TIMEDP  =  NPOINTS* A3  (42) 

WRITE  (*,  6110)  NPOINTS 
6110  FORMATC  ’,14,’  Points  have  been  deleted.’) 

WRITE  (*,  6120)  TIMEDP 

6120  FORMAT(’  ’.’This  corresponds  to  a  time  delay  of:  ’,F9.5,’  ms.’) 

WRITE  (*.  6130)  LOWERI,  NHIGH 
6130  FORMAT(’  ’.’The  indices  are:  ’.216) 

PAUSE 
NP  =  0 

DO  1300  I  =  LOWERI.  NHIGH 
PR  (NP  +  1)  =  PR  (I) 

ORGP  (NP  +  1)  =  PR  (I) 

T  (NP  +  1)  =  T  (I) 

C  T(NP+1)=NP*A3(42)/1000. 

IF  (ITYPE  .EQ.  5)  THEN 
EE  (NP  +  1)  =  EE  (I) 

END  IF 


NP  =  NP+  1 
1300  CONTINUE 

IF  (NUMS  .LE.  0)  THEN 
NE  =  NP 
NS=  1 
END  IF 

^***************4******************************************************* 

C*********  CLEARING  THE  REMAINDER  OF  THE  ARRAY  TO  ZERO  ***************** 
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1310  CONTINUE 
NPP  =  NP  +  1 
DO  1320  I  =  NPP,  2048 
PR  0)  =  0.0 
ORGP  0)  =  0.0 
IF  (ITYPE  .EQ.  5)  THEN 
EE  a)  =  0.0 
END  IF 
T  a)  =  0.0 
1320  CONTINUE 

C**************  MESSAGE  FOR  DATA  SMOOTHING  IN  PROGRESS  ***************** 

Q  *  *  *  *  *  <•  Iliiti «  *  *  *  4i  *  «  4>  *  *  *  «  «  4r « |(|  *  *  *  «  *  *  *  4||||  4t  I|»ti  4>  4i  4I  *  *  *  *  *  4>  4i  41 4i  *  *  *  *1(1  «|  *  4ii|>  «|  4f  *  4r  *  *  *  *  *  «t  * 

1330  CONTINUE 
CALL  CLEAR 
WRITE  (*,  6140) 

6140  PORMAT(///,10X,’******'''*********'''*’'"*"*'*******'*"*"*‘***'''***'''***''"‘'**’, 
l/.lOX,’*********  DATA  IS  NOW  BEING  PROCESSED  *•****•*’, 

2/.10X.’*****  THIS  CAN  TAKE  UP  TO  SEVERAL  MINUTES  ****’. 

3/^  1  OX  ^  ) 

^4ii|<it<**4i*««4<4i4i*i|i4t4c4t4i4!***4i4i4i**i|i:»itiiti4<«4>4>*4i«4ii»4>4i4i4'*4<4i4>***4>i|i4i*4<4f4<4<4i4c*4i*itiit>*iti4>i|>4< 

^4i4i#i|i4i4ii|<4>4i4>4i4<4>4i4>4ii^44<  dfltd  iS  SITlOOthcd 

Q4i*4i4i4i**4i«i4i*«4>**4<*i|i4i  OPTION  1  &  2  <l«"*'**4"l"«"('****'*'**4"t'*‘'*'4"*'*****')'4'4>*'i' 

^4i4i4i**4ii|iit>*4i4i4t4i*4>***4i4i**4i*4<*4i«***4i4ii|c4>it<4>4'«**i|i***i|>*4>4i*4<**4i*4>4>4<4»|c>«"l<4<*****4>*4c 

IF  (aCHOICE  .EQ.  1)  .OR.  (ICHOICE  .EQ.  2))  THEN 
NS=  1 
NE  =  NP 

CALL  SMOOTH  (T,  PR.  PS.  PDOT.  NUMS.  DELTAT) 

GOTO  1340 
END  IF 

Q«i|i4c4>4r4r4i**4i4>**i|<4>4i4>4c4i*4i*4>4i4<**i|i4>*««4<*****4iiK4i*«*****«4i4t*4iiK4>4i4r*4i*i<i4i4>4>4i*4i4<4i4i4i 

Q*4i*4i**i|i4>4t4[***4i«4<4>it>4<  fl^QW  OPTION  3  &  4  *****<•"•"•> 

Qm****************************************!****************************** 

EF  (GCHOICE  .EQ.  3)  .OR.  (ICHOICE  .EQ.  4))  THEN 
DO  1350  I  =  1.  NP 
IF  (PR  G)  GT.  PCTJT)  THEN 
NE  =  I  -  1 
GO  TO  1360 
END  IF 

1350  CONTINUE 
NS=  1 
NE  =  NP 

CALL  SMOOTH  (T,  PR,  PS.  PDOT.  NUMS.  DELTAT) 

GO  TO  1340 
1360  CONTINUE 
NS=  1 
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CALL  SMOOTH  (T,  PR.  PS.  PDOT.  NUMS.  DELTAT) 
NS  =  NE  +  1 


NE  =  NP 

CALL  SMOOTH  (T.  PR.  PS.  PDOT.  NUMS.  DELTAT) 

END  IF 
CALL  CLEAR 

WRITE  (*.  *)  ’The  derivative  has  been  calculated.’ 

^  *  4i  «i|i  1)1  *  4ii|i  *  *41 4ii(i  4i  ***  *41*  4<  III  *  4i  ***  4i  *  4>  4>  4>  4>  *  4>  4"t>  4>  4>  *  <l>  ***>(•*'*■<*"•<  4>  ■t'**  ■)< 

Q*******************  jjijp  file  is  WRITTEN  ***********************’•"•"•"'"''♦* 

q******************************************************>|i>|i*i|ii|i****4ii)»K>Ii*>X4i4i 

1340  CONTINUE 

OPEN  (UNIT  =  5.  FILE  =  FINF) 

REWIND  (UNIT  =  5) 

DO  13701  =  1.6 
WRITE  (5.  6150)  A2  G) 

1370  CONTINUE 
DO  13801  =  1.20 
WRITE  (5.  6160)  A1  a) 

1380  CONTINUE 
DO  13901  =  1.  100 
WRITE  (5.  *)  A3  (I) 

1390  CONTINUE 
DO  14001  =  1.  11 
DO  1410  J=  1.  15 
DO  1420  K=  1.5 
WRITE  (5.  *)  P  (I.  J.  K) 

1420  CONTINUE 
1410  CONTINUE 
1400  CONTINUE 
6150  FORMAT(A80) 

6160  FORMAT(A20) 

CLOSE  (UNIT  =  5) 

^************************************************************4i4>*i|i**i|i4i4i4ii# 

(^***********************  OPTION  TO  FORCE  MONATOMIC  PRESSURE  *****••♦*♦** 
^*********************************************************************** 

IFFY  =  0 

^*************************************************************41***4141**** 
(^*******************  first  are  POINTS  OUT  OF  ORDER  ********************* 
^*********************************************************************** 

DO  1430  I  =  1.  NP  -  1 

IF  (PR  a)  ge.  PR  a  + 1))  iffy  =  1 

1430  CONTINU’E 

^*********************************************************************** 
^*******************  OPTION  IS  OFFERED  ********************************* 

^4ii»4i4i*4i*4i4i4i4i************************************************************ 

IF  (IFFY  .EQ.  1)  THEN 
CALL  CLEAR 

WRITE  (*.  •)  ’The  pressure  is  not  strictly  increasing.’ 
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WRITE  (*,  *)  ’Do  you  wish  to  adjust  the  dau  so  that’ 
WRITE  (*,  *)  ’the  pressure  is  strictly  increasing?’ 
WRITE  (*,  *)  ’Enter  your  choice.  (Yes  =  1,  No  =  2)’ 
READ  (*,  *)  IFFYl 
IF  (IFFYl  .EQ.  2)  GO  TO  1440 


Q  4>  *  *  IK  *  «  *  *  *  *  *  Hi  4i  Hi  Hi  III  4i  He  4>  *  «  *  *  «  *  41  *  *  *  «  4t  4i  4t  Hi*  *  <■  4i  *  *  *  *  41 4i  Hi  m  41  <•> «  41 «  *  *  4>  *  *  *  «<  >l>  it«l»|c4«t>  *  *  *  4> 

(^4»i<**4<4i4i**4c4i4i4i*  PRESSURE  IS  MADE  STRICTLY  INCREASING  ******************* 

Q4iiK4iiKiK*iK4<****4<*************4<*********4i*4<***************************4<iK4<** 


DO  1450  I  =  NP-  1.2,  -  1 
IF  (PR  a)  GT.  PR  (I  -  D)  GO  TO  1450 
DO  1460  K  =  2, 1  -  1 
IF  (PR  a)  .GT.  PR  a  -  K))  THEN 
IDX  =  I  -  K 


GO  TO  1470 
END  IF 

1460  CONTINUE 

Q4i4i4iiK4iiKiK********4i****4<4>*  POINT  IS  LOW  POINT  IN  DATA  ******************** 
IDX=  1 

1470  CONTINUE 

XBOT  =  I  -  IDX 

XSTEP  =  ABS  ((PR  a)  -  PR  (1DX))/XB0T) 

DO  1480  J  =  I  -  1.  IDX  +  1.  -  1 
PR  (J)  =  PR  (J  +  1)  -  XSTEP 
IF  (PR  (J)  .LE.  PIGN)  PR  (1)  =  PIGN 
1480  CONTINUE 

1450  CONTINUE 
END  IF 

Q4i4i*************4i***4i******4<*********4<*****4i4<***4<*4c4>*4>*****4'***iK******** 

Q4i4i4>*******4i4<4i**4i*iK  GRAPH  OF  CURVES  IS  PRESENTED  *********************** 

^4iiK4iiK4<*4>*************4i4i****4<*********4i4>4i4<4>4i4i4<**<K*4i***4>4<4i4>*4>****4'****4i4i4i4i 

1440  CONTINUE 
CALL  CLEAR 


WRITE  (*,  *)  ’1.  Plot  reduced  data,  widpts  removed,  no  smoothing’ 
WRITE  (*,  *)  ’2.  Plot  reduced,  smoothed  data’ 

WRITE  (*,  *)  ’3.  Oveiplot  1.  &  2.’ 

WRITE  (*,  •)  ’4.  No  plot’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (•,  *)  ’Enter  your  choice  (1  -  4)’ 

READ  (*,  •)  lYR 

IF  GYR  .EQ.  4)  GO  TO  1490 

XAXISL  =  ’Time  (Sec)’ 

YAXISL  =  ’Pressure  (MPa)’ 

TITLE  =  ’Press  Vs  Time;  File:’//Al  (14) 

C  'nTLE=’Pressure  Versus  Time’ 

IF  GYR  .EQ.  1)  THEN 

CALL  PL88LG  (T,  ORGP,  NP,  XAXISL.  YAXISL,  TITLE,  MODEL) 
END  IF 

IF  GYR  .EQ.  2)  THEN 
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CALL  PL88LG  (T,  PR,  NP,  XAXISL,  YAXISL.  TITLE,  MODEL) 

END  IF 

EF  (lYR  .EQ.  3)  THEN 

CALL  PL880P  (T.  ORGP,  PR,  NP.  XAXISL.  YAXISL,  TITLE,  MODEL) 

END  IF 

^itr  4i  itciK  0  4i  *  4i*4i  *4i*4i**  *41 4i4t4iiti*  4<  4i  **  K  **  4>  4>  *«»***  K  *  <K  >!«•>  IK*  « >«>)")<■•>  4<  >l<  >t«t>  4<  « 

^4>4i4i>i>4>4>iic4c4i4i4<**4<4<4<**  ANOTHER  PLOT  OR  SMOOTHING  ************************** 

Q4iii<4<4i**4i4>******4>*******************4i*4i4i*4<*4'4>4>***********4<*******4>4<****4i* 

1500  CONTINUE 
CALL  CLEAR 
WRITE  (*.  •)  ’  ’ 

WRITE  (*.  •)  ’  • 

WRITE  (*.  •)  '1.  Additional  plot.’ 

WRITE  (*,  *)  ’2.  Wildpoints  or  Smoothing  with  different’ 

WRITE  (*,  ♦)  ’  option  or  bridge  length.’ 

WRITE  (*,  ♦)  ’3.  Save  current  smoothed  data  and  exit.  ’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’Enter  your  choice.  [1  -  3]’ 

READ  (*,  •)  lANT 
IF  GANT  .EQ.  1)  GO  TO  1440 
IF  GANT  .EQ.  3)  GO  TO  1490 
IF  GANT  .EQ.  2)  THEN 
IPLCH  =  1 
DO  15101=  1,2048 
PR  G)  =  ORGPl  G) 

1510  CONTINUE 
GOTO  1110 
END  IF 

WRITE  (*,  *)  ’Your  choice  is  not  between  1  and  3.’ 

PAUSE 
GO  TO  1500 

^4i4i4i*4i*4<4<*4<***4>4<*****4>*******4*****4<4<4<i)<4>4<>i<4<4i*44i4<*4i4<4i4>4<4>*i|>4<4c4>i|i44>4>4i4>4>4>4<4i4<* 

Q*4i4i4r4>4>4>4>4<4i*44<4>  y^e  data  is  written  to  the  output  file.  **************** 

Q4i4i**4^4^4l4^4>4i4<*4<4'4^4>4<*4i*4'*******4^************4>4>*4<*4<*4l44'*4>**4l4•**4•**44<l|<44^4<4I4<* 

1490  CONTINUE 

OPEN  (UNIT  =  3,  FILE  =  A1  (14),  STATUS  =  ’NEW’,  ERR  =  1520) 

REWIND  (3) 

IST=  1 

IF  G^  .GT.  999)  THEN 
1ST  =  NP  -  990 
END  IF 

DO  1530  I  =  1ST,  NP 
TX  =  G  -  1ST)* A3  (42)/1000. 

C  TX=TG) 

IF  (ITYPE  .EQ.  5)  THEN 
WRITE  (3,  *)  TX,  PR  (I),  PDOT  (I).  EE  (I) 

ELSE 

WRITE  (3,  *)  TX,  PR  (I),  PDOT  (I) 
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END  IF 

1530  CONTINUE 
CLOSE  (UNIT  =  3) 

GO  TO  1540 
1520  CONTINUE 
CALL  CLEAR 

WRITE  (*,  *)  *An  error  has  occurred  on  opening  the  file  to  save’ 

WRITE  (*,  *)  ’the  smoothed  data.  Most  likely  the  file  already’ 

WRITE  (*,  *)  ’exists.  Enter  a  new  file  name.’ 

READ  (*.  5030)  A1  (14) 

5030  FORMAT(A20) 

GO  TO  1340 
1540  CONTINUE 
WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’This  program  has  finished  preparing  the  data.’ 

WRITE  (*,  *)  ’The  prepared  data  is  in  the  output  file:  ’,  A1  (14) 

WRITE  (•,  *)  ’The  information  file  is:  ’,  FINE 
WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’Press  Enter  to  Continue’ 

READ  (*,  *) 

GOTO  1110 
1 120  CONTINUE 
END 

SUBROUTINE  PIG  (PIGN,  A3,  P) 

^  *  4ii|i  III  *  «  *  4i «  4i  *  4i  *  «  *  *  11141*  •  *  4i «  4i  4i  4>  4>  4ci|i  *  *  4t «  *  III  *  *  i|> « it>  *  *  *  *  4i  4i  *  *  *11141  *  *  4i  Ik  4,  <1 4i  *  *  *  *  *  *  *  4t  1*1  *  * 

C  Version;  3.0,  January  1992 


Written  by:  William  Oberie,  U.S.  Army  Research  Laboratory 

Purpose:  This  routine  determines  a  value  to  be  used  as  the  lowest 
pressure  to  be  saved  in  the  data  file.  It  is  based  upon 
80%  of  the  pressure  due  to  the  igniter  after  the  pressure 
has  been  adjusted  for  heat  loss. 


Q  4i  4i  4i  Ik  4i  4i  4i  4i  *  4i  *  *  i»  *  *  *  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  *  4i  4i  4i  4i  4i  4i  4i  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Ik  4i  4i  4i  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4iik  4i  4i  4i  Ik 

DIMENSION  A3  (100),  P  (11,  15,  5) 

04i4i4i4i4i4iik4i4i4i4i4i4i4i4i4i4i4i4i**4i4i4i*i4i4i4i4i4i4i4i4i4i4i4i4i*ik4iik4i4iikikik4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4iikik4i4i4i4i4i4i4i 

C****  THE  UNCORRECTED  PRESSURE  DUE  TO  THE  IGNITER  IS  FOUND  ♦•••**♦****** 

^  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  4i  4i  *  *  *  4i  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Ik  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4iik  Ik  *  Ik  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4iik  Ik  4i  4i  4i 


N  =  INT  (A3  (4)  +  .5) 

SUM  =  0.0 
DO  10001=  1,N 
SUM  =  SUM  +  P  (8, 1,  3) 

1000  CONTINUE 

SUM  =  SUM* A3  (46) 

V  =  A3  (23)  -  A3  (17)* A3  (26)  -  SUM 
A3  (29)  =  A3  (13)* A3  (26)/V 
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^  Itiilc  *41 1|< «  4c  4I  Hi  *  41  «  g<  *  «  *  *  *  *  *  *  «  «  4ii|i  4i  4>  4||||  4<  4i  I|<  41 4>  III  *  >(•  4i  41 « I|<  1|> «  «  *  III  « I|<  itiitciti  I|<  4>  %  41  Itc  Iti  It>  I|<  4c  4II||  Iti  *  *  « 

c******4c  the  theoretical  maximum  pressure  is  determined  **************** 

^4i************4i********4i*********4i4i4i4i*****4c4i4i4i4i4i4i***4c4c4c4c4c4i4c4c4c4c4c4i4c4c4i4i4i4i4c4c 

SUMTl  =  A3  (13)* A3  (26) 

SUMBI  =  A3  (17)*A3  (26) 

SUMT  =  0.0 


SUMB  =  0.0 


DO  1010  I  =  l.N 

SUMT  =  SUMT  +  P  (4, 1.  3)*P  (2,  I.  3)/P  (8. 1.  3) 
SUMB  =  SUMB  +  P  (4. 1,  3)*P  (6, 1.  3)/P  (8. 1.  3) 
1010  CONTINUE 

SUMT  =  SUMT* A3  (46)  +  SUMTl 
SUMB  =  A3  (23)  -  SUMB*A3  (46)  -  SUMBI 
A3  (44)  =  SUMT/SUMB 


^4c4c4i4c4i4i4i4i4i**4i*4i4i4i******4<************************************************ 


C************  THE  LOWER  LIMIT  OF  PRESSURE  IS  DETERMINED  **************** 

^4i4i4i4i4c4i4i******4c4c4i******4<4i********4i4i4i*4>4i***4c***************************** 

PIGN  =  A3  (29)*A3  (43)/A3  (44)*.8 

RETURN 

END 

^4i4c4i4i4i4c4i4i4c4i***4i*4i**4i***4i4c4c4c******4c************************************** 


SUBROUTINE  CBWILDPT  (PR,  NP.  NUMW.  XWP) 

Q  4c**4c4i**************************4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4i4c4i4c4c4c4c4c4c4c4c4c4i4c4c4c4c4<****** 

C  Subroutine:  CBWILDPT.FOR 
C 

C  Encoder  Kristopher  Koehnen 
C  Applied  Combustion  Technology,  Inc. 

C  P.O.  Box  17885 
C  Orlando,  FL  32714 
C 

C  (305)  889-7337 

C  Summary:  This  subroutine  is  used  to  remove  wild  points  from  the  data. 

C  This  subroutine  was  modified  from  the  original  (see  ref.  1) 

C  to  be  used  in  the  development  of  a  system  to  acquire,  prepare 
C  and  analyze  data  from  the  closed  bomb  experiments  for  the 
C  U.S.  Army  Research  Laboratory  -  Advanced  Ballistics  Concepts 
C  Branch. 

C 

C  Irq)ut:  PR:  array  containing  the  pressure  values 
C  NP:  numter  of  points  in  the  array  P 

C 

C  Output:  PR:  pressure  array  with  the  wild  points  removed 
C 

C  Reference  1:  Domen,  John  K.  "Gosed  Bomb  Dau  Analysis  and  Reporting, 

C  (Revision  of  MIL-STD-286B,  Methods  801.1.2  and  804)", 

C  Final  Report,  March  1986,  AMCCOM  AMSMC-QAH-T(D),  Dover, 

C  NJ  07801-5001,  Page  5 
C 
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DIMENSION  PR  (2048) 

DO  1000  KKL  =  1,  NUMW 
CN  =  1./32. 

CNPOL=  1./70. 

CN2  =  1./224. 

NTEN  =  NP  -  10 
DO  1010  1=1,  NTEN 
J  =  I  +  5 

VAl  =  PR  (J  -  5)  +  PR  (J  +  5) 

VA2  =  PR  (J  -  3)  +  PR  (J  +  3) 

VA3  =  PR  (J  -  1)  +  PR  (J  +  1) 

VBl  =  PR  (J  -  5)  -  PR  (J  +  5) 

VB2  =  PR  (J  -  3)  -  PR  (J  +  3) 

VB3  =  PR  (J  -  1)  -  PR  (J  +  1) 

A  =  CN*(  -  3.0* VAl  +  7.0* VA2  +  12.0*VA3) 

A1  =  CNPOL*(  -  5.0*VB1  -  3.0*VB2  -  VB3) 

A2  =  CN2*(5.0*VA1  -  VA2  -  4.0*VA3) 

M  =  -  7 
WAR  =  0.0 
DO  1020  KK=  1,  11,2 
K  =  KK  -  6 

1030  CONTINUE 
M  =  M  +  2 

IF  (M  .EQ.  0)  GO  TO  1030 
YTEMP  =  A  +  A1*M  +  A2*M*M 
YABS  =  ABS  (PR  (J  +  K)  -  YTEMP) 

YVAR  =  YVAR  +  YABS 
1020  CONTINUE 

YAVE  =  YVARy6. 

YDIFF  =  ABS  (PR  (J)  -  A) 

IF  (YDIFF  .LT.  1.1)  GO  TO  1010 
IF  (YDIFF  .LE.  XWP*YAVE)  GO  TO  1010 
1040  CONTINUE 

PR  (J)  =  A 
1010  CONTINUE 
1000  CONTINUE 
RETURN 
END 

SUBROUTINE  SMOOTH  (T.  PR.  PS,  PDOT,  NUMS,  DELTAT) 

COMMON  /CNTROIV  ILENGT.  NS,  NE 
DOUBLE  PREQSION  COFF  (35) 

DIMENSION  POINTS  (35).  T  (2048),  PR  (2048),  PS  (2048).  PDOT  (2048) 
DIMENSION  LIN  (2048) 

^*4i4i4i4i4i4i4i4i4>*4i4>4i4t4>4i*4i***4i*4i4i*4i4i4i4i4i4>*4i4>4>4i4i*4i*4i4i*4i**4>*4<4>4i4>4>4>4<4'4i4>4<4>4i4i4i4<*4>*4t4i 

C  Version:  3.0,  January  1992 

C 
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Written  by:  William  Obeile,  U.S.  Army  Research  Laboratory 


Purpose:  This  subroutine  will  smooth  closed  bomb  data  and  calculate 
the  derivative  from  the  Srd  data  point  until  the  maximum 
pressure  is  reached.  This  subroutine  uses  a  second  degree 
least  squares  polynomial  fit  with  a  variable  bridge  length. 

The  bridge  length  is  automatically  determined  and  is  equal 
to  the  minimum  number  of  points  that  are  in  a  pressure  window 
about  one  of  the  data  points  with  the  window  being  10%  of  the 
maximum  pressure.  However,  the  range  of  the  bridge  is  between 
5  and  35.  The  program  also  uses  a  shrinking  bridge  to  avoid 
smoothing  beyond  Pmax.  The  work  is  based  upon  earlier  work 
by  J.  Domen  and  W.  Lippencoa. 

(^4.4.*4.4.*4.*4.*4,******  f^QW  THE  SMOOTHING  IS  PERFORMED  ********************** 

^  *  4i  4i  *  4c  #  «  *  *  4i  *  «  *  «  *  *  Ik  «  *  *  «  *  *  *  *  «  *  i|t  4ii|<  *  4> «  4i  41  Hi  4i  I*  III  1)1  Hi  4: «  *  *  *  «  Hi  *  *  4<  *  %  *  *  4<  *  >l>  **  il<  >l>  i|>  4>  <l> 

IF  (NUMS  .EQ.  0)  GO  TO  1000 
DO  1010  II  =  1.  NUMS 
WRITE  (*.  6000)  II.  NUMS 

6000  FORMATC  ’.’PROCESSING:  Smoothing  Pass  ’.12.’  of  ’.12.’.’) 

^  4c  4>  4i  4<  4c  4<  4i  4>  4i  4i  *  4>  4i  4>  4i  4c  4<  4>  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4c  4c  4i  4i  4i  4>  41 4<  4c  4t  4>  4c  4<  4i  4<  4i  4i  4c  4i  4c  4c  4c  4<  41 4c  4<  4i  4<  4c  4c  4i  4i  4i  4t  4i  4c  4c  4i  4i  4i  4>  *  4c 

(-•4c4c4c4c4<4c4c4c4c4c4c4c4c4c«4c4c  EACH  POINT  IS  DONE  AS  A  WEIGHTED  AVERAGE  ************ 
^4c4c4c4c**********************  OR  CONVOLUTION  ***************************** 
0*********************************************************************** 
0*4c4c4<********  the  FIRST  AND  LAST  TWO  POINTS  ARE  NOT  SMOOTHED  *********** 
o*********************************************************************** 
LASTL*0 
PS  (NS)  =  PR  (NS) 

PS  (NS  +  1)  =  PR  (NS  +  1) 

PS  (NE  -  1)  =  PR  (NE  -  1) 

PS  (NE)  =  PR  (NE) 

0*********************************************************************** 
0*****************  NOW  THE  REMAINING  DATA  POINTS  *********************** 
0*********************************************************************** 

DO  1020  I  =  NS  +  2,  NE  -  2 

0*********************************************************************** 

C  The  pressure  window  (DELTP)  is  detennined.  It  is  10%  of  the  maximum 
C  pressure  and  it  will  be  used  to  determine  the  bridge  length. 
0*********************************************************************** 

DELTP  =  0.1  •PR  (NE) 

0*********************************************************************** 

C  First,  the  bridge  length  is  determined.  It’s  length  will 
C  depend  upon  the  number  of  pressure  points  with  in  the 
C  pressure  interval  DELTP.  PTOP  is  the  upper  limit  of  the 
C  interval.  PBOT  is  the  lower  limit  of  the  interval. 
0*********************************************************************** 

IF  (ILENGT  .GT.  0)  THEN 
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LENG  =  ILENGT 
GO  TO  1030 
END  IF 

^  i|i4t  4>  *  4i  *  4>  *  *  *  *  *  *  «  4i  *  *  «  «  *  iliitr  *  4i  4t  4<  !•! «  *  *  *  «  4c  *  4i  it<  4c  4<  4<  *  ]ti  %  «  *  *  %  4t  *  «  «  4<  4c  !|<  4t «  il.  4t  *111 

^*4c4c4c4c4c4c4c4c4c4c4c***4c4c4c4c*  FLOATING  BRIDGE  ******‘**************************** 

Q  4c4>4c4c4c4c4c4c4c4c4c4c4c4c4c4c4>4c*4c4c4c4c4c4c4<4c4c4c4c*4c4cc*4c4c4c4>4>4>4c4c4<4c4c4c4c4c4c4c4c4c4c4c4<4'4c4c4i4<*ctc4c4c4c4c4c4c4c4c 


LEN  =  17 
DO  1040  J  =  2,  17 

rrop  =  I  +  J 

DF  OTOP  .GT.  NE)  GO  TO  1050 
IBOT  =  I  -  J 

IF  GBOT  .LT.  NS)  GO  TO  1050 
DELTA  =  PR  (TTOP)  -  PR  (IBOT) 

IF  (DELTA  -  DELTP  .GT.  0.0)  THEN 
LENGTH  =  MAXO  (J  -  1.  2) 

GO  TO  1060 
E^4D  IF 

1040  CONTINUE 
1050  CONTINUE 

LENGTH  =  MAXO  (J  -  1.  2) 

1060  CONTINUE 

LEN  =  MINO  (LENGTH.  LEN) 

LENG  =  LEN*2  +  1 
1030  CONTINUE 
1070  CONTINUE 

ISTART  =  I  -  (aENG  -  l)/2) 

IF  (ISTART  .LE.  0)  THEN 
LENG  =  LENG  -  2 
GO  TO  1070 
END  IF 

1080  CONTINUE 

lEND  =  I  +  ((LENG  -  l)/2) 

IF  (lEND  .GT.  NE)  THEN 
LENG  =  LENG  -  2 
GO  TO  1080 
END  IF 


4>  4c  4c  4c  4c  4c  4>  4>  4c  4>  *  4c  4>  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  **  4c  4c  4c  4c  4<  4c  4c  4>  4<  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4>  4>  4c  4c  4c  4' 4c  4' 4c  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c  4>  4c 
^4c4c<4<»4c*4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c.»  DATA  POINT  IS  SMOOTHED  4c 4. 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 4c 

^  4c  4c  4c  4c  4c  4c  c*  c*  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  c»  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

C***********  COEFFICIENTS  ARE  OBTAINED  FOR  CORRECT  LENGTH  ♦••t********** 

Q  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


IFLAG  =  I 
LIN  a)  =  LENG 

IF  (LENG  .EQ.  LASTL)  GO  TO  1090 
LASTL  s  LENG 

CALL  ARRAY  (IFLAG,  LENG.  COFF) 

Q4c  ck  Ik  Ik  4c  4c  ck  4c  4c  4c  ck  4c  *  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  Ik  ck  4c  Ik  4c  Ik  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  <k 

C********  Now  the  points  are  placed  in  the  airay  Point.  •4c4c4cck*4.4c4i4c4c4c4c4c4i4c 
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Q  *  «  *  3tii|i  111 « Iti  *  4ii(i  Itiiti  4i  3|ci(i  4<  4ii|i «  «  « It>  41 «  4<  %  4' >)>  4<  >t<  >)< «  4<  %  *  %  4c  *  1|<  I|< «  «  «  4t  Iti  V  1|<  III  It<  *  *  <1  *  >*■  4>  *  >«■  %  >t<  ♦  *  >)<  *  >t< 

1090  CONTINUE 
NN  =  1 

DO  1100  II  =  ISTART,  lEND 
POINTS  (NN)  =  PR  ai) 

NN  =  I>IN  +  1 
1100  CONTINUE 

^  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  41 4>  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i 

^4i4i4i*4i4i4i4i4i4i4ii»4i4i4i4i4i4i  THE  CONVOLUTION  IS  COMPUTED  ************************ 

^  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  «•  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 

CONVOL  =  0.0 
DO  1110  12=  1,  LENG 

CONVOL  =  COFF  (I2)*POINTS  (12)  +  CONVOL 
1110  CONTINUE 

PS  (I)  =  CONVOL 
1020  CONTINUE 

DO  11201  =  NS.  NE 
PR  0)  =  PS  a) 

1120  CONTINUE 
1010  CONTINUE 

^  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4  4c  4i  4c  4i  4c  4c  4c  4i  4i  4i  4i  4c  4i  4i  4c  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4  4i  4i  4>  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4c  4i  4c  4i  4c  4c  4c  4c  4c  4i  4c  4i  4i 
^4i4c4i4i4i4c4i4i4i4i4i4i4c4i4c4i4i4c  THE  DERIVATIVE  IS  COMPUTED  **4i4i4t4i4c4i4i4i4c4c4c4c4c4c4c4i4i4i4i4i4i4i4i 
^  4i  4i  4i  4c  4i  4i  4i  4c  4i  4c  4>  4c  4c  4i  4>  4i  4>  4c  4c  4<  4i  4<  4  4c  4i  4i  4i  4c  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4c  4c  4c  4i  4i  4c  4c  4i  4i  4<  4i  4< 

1000  CONTINUE 

IF  (NUMS  .EQ.  0)  THEN 
DO  1130I  =  NS.  NE 
PS  (I)  =  PR  G) 

LING)  =  5 
1130  CONTINUE 
END  IF 

^  4c  4c  4c  4i  4c  4c  4c  4c  4c  4i  4  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

C**********  dp/dt  will  be  in  units  of  million  MPa/scc  **************t‘*** 

^4444c4*44c4444444444444444444444444444444444c44444444444444444444444444444 

C***44*4  first  and  LAST  TWO  POINTS  ARE  FORWARD  &  BACKWARD  dIFF********** 

^44444414444444*444444444444444444444444444444444444444444444444444444444 

PDOT  G^S)  =  ((PS  (NS  +  1)  -  PS  (NS))/1000.)/((TG^S  +  1)  -  T  (NS))*1000.) 

PDOT  (NS  +  1)  =  (G*S  (NS  +  2)  -  PS  (NS  +  1))/1000.)/((T(NS  +  1)  -  T  G^S))*1000.) 

PDOT  -  1)  =  (G»S  -  1)  -  PS  (NE  -  2))/1000.)/((T(NE  -  1)  -  T  G^  -  2))*1000.) 

PDOT  (NE)  =  (G»S  (NE)  -  PS  (NE  -  1))/I000.)/((T(NE)  -  T  (NE  -  1))*1000.) 

IFLAG  =  2 
LASTL  =  0 

DO  1140I  =  NS  +  2.  NE-2 

^44444444444444444444444444444444444444444444444444444444444444444444444 
(^4444444444444444444  THE  CONVOLUTION  IS  COMPUTED  44444444444444444444444 
^44444444444444444444444444444444444444444444444444444444444444444444444 


262 


LENG  =  LIN  0) 

IF  aENG  .ME.  LASTL)  THEN 
LASTL  =  LENG 

CALL  ARRAY  (IFLAG.  LENG,  COFF) 
END  IF 

MOV  =  (LENG  -  l)/2 
ISTART  =  I  -  MOV 
lEND  =  I  +  MOV 


NN=  1 

DO  1150  II  =  ISTART,  END 
POINTS  (NN)  =  PS  ai) 

NN  =  NN+  1 
1150  CONTINUE 
CONVOL  =  0.0 
DO  116011=  LLENG 

CONVOL  =  COFF  (II)*POINTS  (II)  +  CONVOL 
1160  CONTINUE 

PDOT  (I)  =  (CONVOL/1000.)/(DELTAT*1000.) 
1140  CONTINUE 
RETURN 
END 


SUBROUTINE  ARRAY 

^**<1 41*41 Hi  4i4>***««*4<**i«i*4i4i4i4>4>4<*****i|>***«««****4>iti>|r**4i*4>*i|>*4<**i|>«i*4t 


SUBROUTINE  ARRAY  (IFLAG,  LENGT.  COFF) 
CHARACTER*?  FEENM 
DOUBLE  PREaSION  COFF  (35) 

DO  1000  I  =  1,  35 
COFF  (I)  =  0.0 
1000  CONTINUE 

E  (IFLAG  .EQ.  1)  THEN 
IF  (LENGT  ,EQ.  5)  RLENM  =  ’S5.CFF* 

IF  (LENGT  .EQ.  7)  FILENM  »  ’ST.CFF* 

IF  (LENGT  .EQ.  9)  FILENM  =  ’S9.CFF’ 

IF  (LENGT  .EQ.  1 1)  RLENM  =  ’SI  l.CFF’ 

IF  (LENGT  .EQ.  13)  RLENM  »  ’SIS.CFF’ 

IF  (LENGT  .EQ.  15)  HLENM  =  •S15.CFF’ 

IF  (LENGT  .EQ.  17)  RLENM  =  ’Sn.CFF’ 

IF  (LENGT  .EQ.  19)  FILENM  =  •SI9.CFF’ 

IF  (LENGT  .EQ.  21)  HLENM  =  ’8210^’ 

IF  (LENGT  .EQ.  23)  FILENM  =  •S23.(EF’ 

IF  (LENGT  .EQ.  25)  FILENM  =  ’825.0^’ 

IF  (LENGT  .EQ.  27)  HLENM  =  ’827.0^’ 

IF  (LENGT  .EQ.  29)  HLENM  =  ’829.0^’ 

IF  (LENGT  .EQ.  31)  HLENM  =  ’831. CFF* 

IF  (LENGT  .EQ.  33)  HLENM  «  •833.CFF’ 

IF  (LENGT  .EQ.  35)  HLENM  -  '835.CFF’ 
OPEN  (UNIT  =11,  FILE  -  HLENM) 
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REWIND  (UN1T=  11) 

DO  1010  1  =  1,  LENGT 
READ  (11,  *)COFF  (I) 

1010  CONTINUE 

CLOSE  (UNIT=  11) 

WRITE  (*,  *)  ’Using  file:  ’,  RLENM 
RETURN 
END  IF 

IF  (IFLAG  .EQ.  2)  THEN 
IF  (LENGT  .EQ.  5)  HLENM  =  ’D5.CFF’ 

IF  (LENGT  .EQ.  7)  HLENM  =  ’D7.CFF’ 

IF  (LENGT  .EQ.  9)  HLENM  =  ’D9.CFF’ 

IF  (LENGT  .EQ.  11)  HLENM  =  ’Dll.CFF* 
IF  (LENGT  .EQ.  13)  HLENM  =  ’D13.CFF‘ 
IF  (LENGT  .EQ.  15)  HLENM  =  ’D15.CFF’ 
IF  (LENGT  .EQ.  17)  HLENM  =  ’D17.CFF’ 
IF  (LENGT  .EQ.  19)  HLENM  =  ’D19.CFF* 
IF  (LENGT  .EQ.  21)  HLENM  =  •D21.CFF* 
IF  (LENGT  .EQ.  23)  HLENM  =  ’D23.CFF* 
IF  (LENGT  .EQ.  25)  HLENM  =  ’D25.CFF’ 
IF  (LENGT  .EQ.  27)  HLENM  =  •D27.CFF’ 
IF  (LENGT  .EQ.  29)  HLENM  =  •D29.CFF* 
IF  (LENGT  .EQ.  31)  HLENM  =  ’D31.CFT’ 
IF  (LENGT  .EQ.  33)  HLENM  =  ’D33.CFF’ 
IF  aENGT  .EQ.  35)  HLENM  =  ’D35.CFF’ 
OPEN  (UNIT  =11,  HLE  =  FILENM) 
REWIND  (UNIT=  11) 

DO  1020  1=  1,  LENGT 
READ  (11,  *)  COFF  (I) 

1020  CONTINUE 

CLOSE  (UNIT=  11) 

WRITE  (*,  •)  'Using  file:  ’,  FILENM 
RETURN 
END  IF 
RETURN 
END 


^****«»4i4i4t4i*4i*4i4i***4>**<>*«***«**«*************<»**4>**«*il>**iti*4>4t4iw4i***4i*4'4i4> 

(^*4i*4.«4i***4i4i4i****4i**»  SUBROUTINE  CLEAR  ******************************** 

^*****4i*»***«i«4i*4i4i***«**4r  ***«**<>  4i4i*********4i4«»****it^*«*«>«i***iti***«*****4>* 


SUBROUTINE  CLEAR 
CHARACTER  ST<'4 
DATA  ST/’  {2J’/ 

WRITE  (•,  6000)  ST 
6000  FORMAT  (1X,A4) 

RETURN 

END 

SUBROUTINE  PL88LG  (X,  Y,  NPTS,  XAXISH,  YAXISH,  TITLEH,  MODEL) 
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COMMON  A3RAPH/  STARTl,  START2.  DELTA  1,  DELTA2 
DIMENSION  X  (2050),  Y  (2050) 

CHARA(7rER*20  XAXISH,  YAXISH 
CHARACTER*40  TITLEH 
CHARACTER*20  YAXISL 
CHARACTER*40  TITLE 
CHARACTER*20  XAXISL 

CHARACTER*!  TITA  (40),  XAXISA  (20).  YAXISA  (20) 

XAXISL  =  XAXISH 
YAXISL  =  YAXISH 
TITLE  =  TITLEH 
DO  10001  =  1.20 
KI  »  21  -  I 

IF  (XAXISA  (KI)  .NE.  ’  *)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 
NXA  =  KI 
DO  1020  I  =  I.  20 
KI  =  21  -  I 

IF  (YAXISA  (KI)  NE.  ’  *)  GO  TO  1030 
1020  CONTINUE 
1030  CONTINUE 
NYA  =  KI 
DO  1040  I  =  1,40 
KI  =  41  .  I 

IF  (TITA  (KI)  NE.  *  ’)  GO  TO  1050 
1040  CONTINUE 
1050  CONTINUE 
NTA  =  KI 
WRITE  (*.  6000) 

WRITE  (*.  6010) 

6010  FORMATCO  DO  YOU  WISH  TO  HAVE  A  HARDCOPY?  (  1  FOR  YES.O  FOR  NO)’) 
READ  (*.  5000)  ICYN 
5000  FORMAT(Il) 

6000  FORMATCO  STRIKE  ENTER  WHEN  RNISHED  WITH  PLOT  ) 

CALL  PLOTS  (0.  97.  97) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6.  HT.  THLE.  0..  NTA) 

C  CALL  SCALE(X,5.00.NPTS.l) 

C  CALL  SCALE(Y,5.00.NPTS.l) 

X  (NPTS  +  1)  *  STARTl 
X  (NPTS  +  2)  =  DELTAl 

Y  (NPTS  ♦  I)  =  START2 

Y  (NPTS  +  2)  =  DELTA2 

CALL  STAXIS  (.25.  .25.  111.  .112.  2) 
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CALL  AXIS  (0..  0.,  XAXISL,  -  NXA.  5.00,  0..  XI  (NPTS  +  1).  X  (NPTS  +  2)) 
CALL  STAXIS  (.25,  .25,  .111,  .112,  -  1) 

CALL  AXIS  (0.,  0.,  YAXISL,  NY  A,  5.0,  90.,  Y  (NPTS  +  1),  Y  (NPTS  +  2)) 
CALL  LINE  (X,  Y,  NPTS,  1,  0,  0) 

CALL  PLOT  (0.0,  0.0,  999) 

IF  aCYN  .EQ.  0)  GO  TO  1060 
CALL  PLOTS  (0,  1,  MODEL) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  irr*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6,  HT,  TITLE,  0.,  NTA) 

C  CALL  SCALE(X,5.00,NPTS,i) 

C  CALL  SCALE(Y,5.00,NPTS,1) 

CALL  STAXIS  (.25,  .25,  .111,  .112,  2) 

CALL  AXIS  (0.,  0.,  XAXISL,  -  NXA,  5.00,  0.,  X  (NPTS  +  1),  X  (NPTS  +  2)) 
CALL  STAXIS  (.25,  .25,  .111,  .112,  -  1) 

CALL  AXIS  (0.,  0.,  YAXISL.  NYA,  5.0,  90..  Y  (NPTS  +  1).  Y  (NPTS  +  2)) 
CALL  LINE  (X.  Y,  NPTS.  1,  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

1060  CONTINUE 
RETURN 
END 

SUBROUTINE  PL880P  (X.  Y.  Z.  NPTS,  XAXISH,  YAXISH,  TITLEH,  MODEL) 
COMMON  /GRAPH/  STARTl,  START2.  DELTAl,  DELTA2 
DIMENSION  X  (2050),  Y  (2050),  Z  (2050) 

CHARACrER*20  XAXISH.  YAXISH 
CHARACTER*40  TITLEH 
CHARACTER*20  YAXISL 
CHARACTER*40  TITLE 
CHARACTER*20  XAXISL 

CHARACTER*  1  TITA  (40),  XAXISA  (20).  YAXISA  (20) 

XAXISL  =  XAXISH 
YAXISL  =  YAXISH 
TITLE  =  TITLEH 
DO  1000  I  =  1,  20 
KI  =  21  -  I 

IF  (XAXISA  (KI)  .NE.  ’  ’)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 
NXA  =  KI 
DO  1020  I  =  1,  20 
KI *  21  -  I 

IF  (YAXISA  (KI)  .NE.  ’  ’)  GO  TO  1030 
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1020  CONTINUE 
1030  CONTINUE 
NYA  =  KI 
DO  10401  =  1,40 
KI  =  41  - 1 

IF  (TITA  (KI)  .NE,  ’  ’)  GO  TO  1050 
1040  CONTINUE 
1050  CONTINUE 
NTA  =  KI 
WRITE  (*,  6000) 

WRITE  (*,  6010) 

6010  FORMAT(*0  DO  YOU  WISH  TO  HAVE  A  HARDCOPY?  (1  FOR  YES,  0  FOR  NO)’) 
READ  (*.  5000)  ICYN 
5000  FORMATai) 

6000  FORMATCO  STRIKE  ENTER  WHEN  FINISHED  WITH  PLOT’) 

CALL  PLOTS  (0,  97.  97) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT.  5.6,  HT.  TITLE,  0..  NTA) 

C  CALL  SCALE(X.5.00.NPTS,1) 

C  CALL  SCALE(Y.5.00.NPTS.l) 

C  CALL  SCALE(Z.5.00.NPTS.l) 

X  (NPTS  +  1)  =  STARTl 
X  (NPTS  +  2)  =  DELTAl 

Y  (NPTS  +  1)  =  START2 

Y  (NPTS  +  2)  =  DELTA2 
Z  (NPTS  +  I)  =  START2 
Z  (NPTS  +  2)  =  DELTA2 

CALL  STAXIS  (.25.  .25,  .111,  .112,  2) 

CALL  AXIS  (0..  0.,  XAXISL,  -  NXA,  5.00,  0..  X  (NPTS  +  1),  X  (NPTS  +  2)) 

CALL  STAXIS  (.25,  .25,  .111,  .112,  -  1) 

CALL  AXIS  (0..  0..  YAXISL,  NY  A.  5.0,  90.,  Y  (NPTS  +  1),  Y  (NPTS  +  2)) 

CALL  LINE  (X,  Y.  NPTS,  1.  0.  0) 

CALL  LINE  (X,  Z,  NPTS,  1,  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

IF  OCYN  .EQ.  0)  GO  TO  1060 
CALL  PLOTS  (0.  1,  MODEL) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6,  HT.  TITLE,  0.,  NTA) 

C  CALL  SCALE(X,5.00,NPTS.l) 

C  CALL  SCALE(Y,5.00,NPTS,1) 
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C  CALL  SCALE(Z4.00.NPTS,1) 

CALL  STAXIS  (.25,  .25.  .Ill,  .112,  2) 

CALL  AXIS  (0.,  0.,  XAXISL,  -  NXA,  5.00,  0..  X  (NPTS  +  1).  X  (NPTS  +  2)) 
CALL  STAXIS  (.25.  .25,  .111,  .112,  -  1) 

CALL  AXIS  (0..  0..  YAXISL,  NYA,  5.0,  90..  Y  (NPTS  +  1),  Y  (NPTS  +  2)) 
CALL  LINE  (X.  Y.  NPTS,  1,  0,  0) 

CALL  LINE  (X.  Z.  NPTS,  1.  0,  0) 

CALL  PLOT  (0.0.  0.0.  999) 

1060  CONTINUE 
RETURN 
END 
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LISTING 


APPENDIX  K: 
PROGRAM  MKCAL.FOR 
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INTENTIONALLY  LEFT  BLANK. 
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PRCXJRAM  MKCAL 


C 

^  *  *41  *  *  Id  « IK  *  *  *  4>  4>  4>  *  4i «  *  *  4>  *  *  Hi  *  Id  *  41  Id  «  *  *  4iit>  *  *  4i  *  *  4ii|i  *  «  Hi  4ci|»ti  *  41  m  «  *  «■  *  *  *  «  KiK)  Hi  4i  »•  m  4>  Hi «  4t  *  *  *  *  * 
^4i*4i4i4i 

C**  "CLBCPV"  =  CLosed-Bomb  Program  with  Continuous  Property  Variations 

^4i4i4i4>4i 


C**  2  E>ecember  1991  Version  (with  Obeile  integrals)  DEK 

^Id4i4i4iid 

C*  MKCAL;  VERSION  3.0,  CLBCPV  +  ADDED  ROUTINES  (30  Dec  91  /  Kooker] 

C  4i*4iid 

C  Latest  Revisions:  2/10/92;  completed  ETC  option 

C  hex  grain  completed 

C  2/12/92;  Newton-Raphson  added 

C  2/22/92;  Cleanup 

^4i  Id  idid  Id  Id  4i*4i  41*41*41 4iid  Id  41  Id  Id  41 41**4141*41  idid  41 4>  41 4i4>4>4i4i4i4i**4i4iid4i4>4i4>4i4i4i4iidididid4i4i4>4i4<4i4>4<4i4<4i4i4>4i 
^***** 


COMMON  /ARRAYS/  A3  (100),  PX  (11.  15,  5) 

COMMON  /ETC/  EE  (1000) 

COMMON  /CONTRL/  NTL,  CHVOL,  HLFRAC,  DT,  NMAX,  CONVRG,  ICTYP 
COMMON  /FIXED/  CHI,  CH2,  CH3,  CAPEO,  QWMAX,  PCHAMX 
COMMON  /SUMS/  SHI,  SH2.  SH3.  SH4 
COMMON  /NVALUE/  RHOSRN,  ASURN,  DPTHBN,  TPMRGM 

COMMON  /SOLUT/TIME  (1000),  PCH  (1000).  RBRl  (1000).  TPMR  (1000),  SMS  (1000),  RHOS 
1  (1000),  TCH  (1000),  DPTHB  (1000),  ASUR  (1000),  LYR  (1000) 

COMMON  /SCALE/  RHOSTR,  TRSTR.  PRSTR,  RBRSTR,  VOLSTR.  SURSTR,  ELSTR 
1  .  SMSSCL.  CVRSCL,  SERSCL,  TIMSCL 
COMMON  /SOLIDL/  SMSOL  (15).  XI  (15) 

COMMON /AVEPROP/  RHOSAV  (15).  SESOAV  (15),  SBCGAV  (15).  RGCGAV  (15), 

1  CVCGAV  (15) 

COMMON  /IGNITOR/  SMSIG,  SESIG,  RHOSIG,  WTMIG,  SBIG.  RGIG,  CVIG 
COMMON  /AIR/  SMSA,  WTMA,  SBA,  RGA,  CVA 
COMMON  /METH/  IMOD 

CHARACTER  A1  (20)*20.  A2  (6)*80.  nNF*20,  NAME1*20.  A*1 

0*****************************************d***************************** 

^***** 


CONVRG  =  .00001 
IMOD=  1 


IQRE  =  0 
1000  CONTINUE 
CALL  CLEAR 
WRITE  (*,  6000) 

6(X)0  FORMAT(////,10X,’Enter  file  name  for  the  calculation.’) 

READ  (*,  5000)  HNF 
5000  FORMAT(A20) 
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I 


IF  (HNF  .EQ.  ’10’)  THEN 
CALLCL^4R 

WRITE  (*.  *)  ’ENTER  THE  CONVERGENCE  CRITERIA’ 

WRITE  (*.  *)  ’THE  DEFAULT  VALUE  IS  l.E-5’ 

READ  (*,  •)  CONVRG 
GO  TO  1000 
END  IF 

IF(nNF.EQ.  ’ll’)  THEN 
IQRE  =  100 
CALL  CLEAR 

Q^^OttlHHt**************************************************************** 

Q)Hf**********^it*****  default  is  integrals  •***************************** 

*  4i  *  111*  *  •  Itiiliili  Ilritiitcid  41  «iti  III «  *  4I  *  «  *  *  «  4i  *  4i  4i  4i  4i  4i  4i4t  *  «  4i  4ii|i «  *  *41  *  111  *  ||< «  «  «  #  *  *  *  <1 4>  * 

WRITE  (*,  *)  ’Do  you  wish  to  use  the  integrals  instead  of 
WRITE  (*,  *)  ’the  fixed  values?  (Yes  =  1,  No  =  2)  Enter  your  choice’ 

READ  (•,  •)  ICONVR 
IF  (ICONVR  .EQ.  2)  THEN 

WRITE  (*,  *)’  Enter  a  1  if  the  grain  has  only  one  larger,  else  a  2.’ 
READ(*.*)ISRS 
ELSE 
ISRS  =  0.0 
END  IF 
GO  TO  1000 
END  IF 

IF  (HNF  .EQ.  ’12’)  THEN 
CALL  CLEAR 

WRITE  (*,  ♦)  ’For  homogeneous  grains  the  search  for  the  depth’ 

WRITE  (*,  ;  ’burned  can  be  performed  using  two  methods.’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’1.  Bisection  method:  will  always  converge  but  slower’ 

WRITE  (*,  *)  ’2.  Newton-Raphson  method:  faster  than  bisection’ 

WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’Select  desired  method’ 

READ  (*,  *)  IMOD 
GO  TO  1000 
END  IF 

NAMEl  =  HNF 
1010  CONTINUE 
DO  10201  =  1,  17 
A  =  NAMEl  a:I) 

IF  (A  .EQ.  ’.’)  THEN 
CALL  CLEAR 

WRITE  (*,  *)  ’The  file  name  entered  has  an  extension  which  is’ 

WRITE  (*,  *)  ’not  allowed.  Please  enter  a  new  name  without  ’ 

WRITE  (♦,  *)  ’an  extension.’ 
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READ  (*.  5000)  NAMEl 
GO  TO  1010 
END  IF 

IF  (A  .EQ.  ’  *)  THEN 
NAMEl  (1:1  +  3)  =  ’.inF 
FINE  =  NAMEl 
GO  TO  1030 
END  IF 

1020  CONTINUE 
1030  CONTINUE 

OPEN  (UNIT  =  12,  FILE  =  FINE,  STATUS  =  ‘OLD’,  ERR  =  1040) 

GO  TO  1050 
1040  CONTINUE 
WRITE  (*.  6010) 

6010  FORMAT(//,10X,’An  Error  Has  Occurred  in  Opening  the  File!’ 
ly.lOX.’The  File  Most  Likely  Does  Not  Exist.  Try  Again’) 

PAUSE 
GO  TO  1000 
1050  CONTINUE 

REWIND  (UNIT  =  12) 

C**********  READING  INFORMATION  FILE  FOR  COMPUTATION  ******************* 

^  *  *  «  *  «  «  4t  *  «  *  4, 4ii|ii|r «  4i  *  *  *  «  4i «  *  *  *  *  *  *  «  4i  4ii|<  *  *  *  4>  4>  *  *  *  *  *  *  *  4<  *  *  *  4t  «>  *  «  *  *  *  *  :*<  III  4i « !«•  1^  i|<  *  4i  *  * 

DO  10601=  1,6 
READ  (12,  5010)  A2  0) 

1060  CONTINUE 
5010  FORMAT(A80) 

DO  10701  =  1,20 
READ  (12,  5000)  A1  0) 

1070  CONTINUE 
DO  1080  I  =  1,  100 
READ  (12,  *)  A3  (I) 

1080  CONTINUE 
DO  10901  =  1,  11 
DO  1100  J  =  1,  15 
DO  1110  K=  1,5 
READ  (12,  *)  PX  (I.  J,  K) 

1110  CONTINUE 
1100  CONTINUE 
1090  CONTINUE 

CLOSE  (UNIT  =  12) 

A3  (100)  =  0.0 
IF  OQRE  EQ.  100)  THEN 
A3  (31)  =  ISRS 
END  IF 

^4>4i4i4i4ii|i4ii|i4<4<4i4<4<4<*4<**4>4>**4i**4i4<*4>**4i4'4i*4<*<|ii|>»4'4>i|<iK4>*4<4«i4c**4c4ii|<4<4c4<i|<4ii|i**4>4<4i4<i|ii|<*i|i 

^4<*i<l<4>il«l>*4i4i*4i*i|i«4<il<*4<**4<  OUTPUT  FILE  IS  OPENED 

^  4, «  4<  4<  4i  4>  *  *  *  *  *  4>  *  <|i  He  *  *  4<  *  *  *  *  4i*i|ii|i  *  *  *  4<  *  *  *  «  *  *  *  *  *  *  4ii|c  4c  4ii|,  i|c  41  *  *  *  4, 4i  4<  *41  *  4<  *  «<  IK  *  *  4i «  *  «  *  4ii|i  * 


OPEN  (UNIT  =11,  FILE  =  A1  (10).  STATUS  =  ’NEW) 


^  *41*  <1  41*  *  4i «  *i|i*  4i4[****  *****  it<  *  4i «  41 41 4i  *  4<  i|>  4«t>  it>  4>  '•<  4<  >)•*>•>>•<  >l>  4' 

Q***** 

C4.***  7  10  20  30  40  50  60  70  2 

C  *41* 

Q*********************************************************************** 

0***** 

(^***********  Define  Reference  Quantities  for  Non-Dimensional  Scaling  *** 

^***** 

f^*********************************************************************** 

Q***** 

C*4-***  RHOSTR  (g/cm3)  =  reference  value  of  DENSITY 
C** 

RHOSTR  =  1.0 
C** 

C*****  VOLSTR  (cm3)  =  reference  value  of  VOLUME  (usually  =  chamber  volu 
Cme) 

C** 

VOLSTR  =  300.0 
C** 

C4.4.4.**  eLSTR  (cm)  =  reference  value  of  LENGTH 
C** 

ELSTR  =  VOLSTR**(l./3.) 

C*4i 

c*****  SURSTR  (cm2)  =  reference  value  of  SURFACE  AREA 
C** 

SURSTR  =  ELSTR*ELSTR 
C** 

C*****  TRSTR  (deg  K)  =  reference  value  of  TEMPERATURE 
C** 

TRSTR  =  3000.0 
C** 

^*****  prstR  (MPa)  =  reference  value  of  PRESSURE 
C** 

PRSTR  =  100.0 
C** 

^*********************************************************************** 

^***** 

Q***********************  ponn  Scale  Factors  **************************** 
^***** 

Q*********************************************************************** 

Q***** 

0*****  SMSSCL  (gm)  =  scale  factor  for  MASS 
(^** 

SMSSCL  =  RHOSTR*VOLSTR 


C*****  SERSCL  (cal/g)  =  scale  factor  for  ENERGY  DENSITY 
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c** 

SERSCL  =  PRSTR/(4.184*RHOSTR) 

C** 

C*****  CVRSCL  (cal/g-deg  K)  =  scale  factor  for  SPEOnC  HEAT 
C** 

CVRSCL  =  SERSCI/TRSTR 
C** 

C*****  RBRSTR  (cm/s)  =  reference  value  for  RATE 
C** 

RBRSTR  =  SQRT  (1.0E+07*PRSTR/RHOSTR) 

c** 


C*****  TIMSCL  (mil-sec)  =  scale  factor  for  TIME 
C** 


TIMSCL  =  (ELSTR/RBRSTR)*1(X)0.0 


C**  IMPORTANT  NOTE;  It  is  assumed  here  that  all  dimensional  "PX"  quantit 
Cies  * 


C**  have  been  loaded  into  the  array  at  this  point 
C  * 

^  4<  *  4i*  *  !)•  4«t<  *  «  4«<  *  *  4>  *  *  *  *  *  *  *  *  *  *  **  »<  *  *  *  *  »  *  O  4>  «  *  «  «  *  *  *  *  *  *  4t «  *  4»l>  *  *  Xotxl' *  *  « 4»l< «  *  * 

(^**Hi»* 

CALL  SETVAL 

^*4i4i4r4t4i*i(iitiiti*ii<it<  5e|  Average  Properties  Across  Each  Layer  *************** 


DO  1120  I  =  1,  NTL 

RHOSAV  G)  =  (PX  (4. 1,  3)/PX  (8.  I.  3))/RHOSTR 
SESOAV  G)  =  (PX  (11. 1.  3)/PX  (8. 1.  3))/SERSCL 
SBCGAV  G)  =  (PX  (6,  I,  3)/PX  (8, 1,  3))*RHOSTR 
RGCGAV  (I)  =  G*X  (9, 1.  3)/PX  (8, 1,  3))/CVRSCL 
CVCGAV  (I)  =  G*X  (10, 1.  3)/PX  (8, 1,  3))/CVRSCL 
1120  CONTINUE 

^*4i*«4i4r4ii|i4>4i4i4iitr4i4ii|c4i*iti4i4i4i4i4i  pQfi^  COOStantS 

^4>**«* 

c** 

CHI  =  CHVOL  -  SBIG*SMSIG  -  SBA*SMSA 
C** 

CH2  =  RGIG*SMSIG  +  RGA*SMSA 
c** 

CH3  =  CVIG*SMSIG  +  CVA*SMSA 
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c** 

*  *  4ii|i  *  Ik  « *  4i  *  lit  *  *  Hi  A*  *  4>  *  4^  i|cit<  <t<  i|<  4<  >l<  it<  *  *  4>  <1 *  *  *  *  *  *  *  «  *  *  *  it< «  *  *  «  *  >•<  *  >•>  *  i|<  *  i|>  *  i|<  *  *  *  *  * 

C*****  Compute  Total  Propellant  Mass  in  Chamber  at  Initial  Condition  *** 

^kiik***! 

(^4iik4«i4>4iik*4>4<>k4i*4i4>4i4>4<**  (Docs  NOT  Includc  Igoitor  Mass)  ****************** 

^ikik4>4<4> 

^  *  Ik  *  Ik  *  Ik  4i  Ik  **  4> «  4>  *  *  Ik  Ik  *  *  *  *  *  *  *  Ik  *  *  *  >k  Ik  Ik  Ik  4<  Ik  *  « Ik  Ik  Ik  Ik  4> «  4<  <•  Ik  4t  *  Ik  Ik  4>  Ik  4<  *  Ik  4i  4>  Ik  Ik  Ik  Ik  Ik  >k  *  Ik  « Ik  *  *  4>  *  * 

^ik4iikikik 

SUMI  =  0.0 
DO  11301=  l.NTL 
SUMI  =  SUMI  +  SMSOL  (I) 

1130  CONTINUE 
C 

TPMR  (1)  =  SUMI 

^  *  **  *  Ik  Ik  *  *  *  *  *  *  *  k  *  k  *  k  Ik  Ik  k  *  4>  Ik  *  %  k  <k  k  4>  k  Ik  k  *  k  Ik  k  k  *  «  k  *  *  *  Ik  k  k  k  Ik  k  k  4>  Ik  k  k  4<  k  k  k  k  k  k  4>  k  Ik  *  k  Ik  k  Ik  * 

^kkkkk 

(^kkkkkkkkk  Compute  Total  Energy  in  Chamber  at  Initial  Condition  ******** 

^kkkkk 

^kkkkkkkkkkkkkkkkkkkk  (Includes  Ignitor  Energy)  ***i*i4i****4iim<>'<i*4i’<ii«i*ii*“*'|*ii«"*ii*' 

^kkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

Qkkkkk 

SUMI  =  0.0 
DO  11401=  l.NTL 

SUMI  =  SUMI  +  SESOAV  (I)*SMSOL  (I) 

1140  CONTINUE 
C 

CAPEO  =  SUMI  +  SESIG*SMSIG 

Qkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkk 

(^kkkkkkkk  COMPUTE  MAXIMUM  HEAT  LOSS  FROM  CHAMBER  Based  on  "HLFKAC"  ***** 

^kkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkk 

(l^kkkkkkkkkkkkkkkkk  assume  all  propellant  IS  CONSUMED  ******************* 

(^kk*** 

C*kkkkkkkkkk  Set  Value  of  "Xi"  =  0.0  for  Each  Layer  (burned)  *********** 

Qkk*** 

^kk*k*k***kkk****k*kkkkkk  [Xi=(SMS/SMSO)i]  ***************************** 

^kk*** 

C**************kkk*kkkk*kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkk 

DO  11501  =  l.NTL 
XI  a)  =  0.0 
1150  CONTINUE 

(^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

Qkkkkk 
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C********  Compute  Sums  Which  Remain  Constant  in  Layer  "J"  (=NTL)  ’•"•‘i'**** 

^*41*41* 

C****  CALL  SHEVAL  (J^TTL)  [SHI, SH2.SH3.SH4  returned  in  COMMON/SUMS]  * 

^4i4>i|>iti4> 

^4i4i4i4i4<4i4c4>4i4i>)>4i*4<4»t"t<4>*4c*4i4i***4i**4i*iti4>4>*4>4>4>4>*«4<*****>)<4<i|><t<'*<4<<t<>l<4<4c4<4^4<4>4<4i4<4>4i4i4i4>4i4> 

^4i4»I>*4> 

c 

CALL  SHEVAL  (ISTTL,  NTL) 

C 

^4>4>**4<*«0<*>t>*4>4'4<>t>4«>***4<****4<*4>4>4t4<«4'4'4<«4>*«4>*4>**4>*4>4»t«l«t<**4«i4>****4<*4i**>t'4>4<4>it>4< 

^4<***« 

C**  Set  average  property  values  to  the  last  "n-th"  layer  which  will  be  " 

CNTL" 

C 

AMCVCG  =  SMSOL  (NTL)*CVCGAV  (NTL) 

AMSBCG  =  SMSOL  (NTL)*SBCGAV  (NTL) 

AMRGCG  =  SMSOL  (NTL)*RGCGAV  (NTL) 

C 

C***  Compute  theoretical  maximum  chamber  temperature  "TCHTMX" 

C  [the  relationships  below  assume  that  XI  =  0.0] 

^4<**4>*4<*******4i4t*4<**4<it«<4i4«K4'4<4t>K*4<*4«l>*<ti4'*>li**4i4i*4»t<>l>4<4>4<4<4>4i*4i«4i4i4<i|>4<*4i>l<4<>l<iK*i|<4<4< 

C*4i«4.*4<*****4i**  etc  COMPUTATION:  ADD  TOTAL  ELECTRICAL  ENERGY  *••*•♦***** 
E«**«>**********  TO  HEAT  LOSS  FACTTOR  DM  COMPUTING  THEORETICAL  *********** 
C**************  PRESSURE  &  TEMPERATURE  &  HEAT  LOSS  FACTOR  ************** 

E***********************************************4<**«******************** 

IF  aCTYP  .EQ.  5)  THEN 

QWN  =  -  A3  (30)*1000000./(4.184*SERSCL*SMSSCL) 

ELSE 

QWN  =  0.0 
END  IF 

TOP  =  CAPEO  -  QWN  -  SH4 
BTM  =  CH3  +  SH3  +  AMCVCG 
TCHTMX  =  TOP/BTM 
C 

C***  Compute  theoretical  maximum  chamber  pressure  "PCHTMX" 

C 

TOP  =  TCHTMX*(CH2  +  SH2  +  AMRGCG) 

BTM  =  CHI  -  SHI  -  AMSBCG 
PCHTMX  =  TOP/BTM 


C***  Compute  maximum  chamber  pressure  WITH  heat  loss  -  "PCHAMX" 

0******************************************************4>4<4i4i4i***4i*4i****4> 

0*************  PCHAMX  WILL  BE  OBSERVED  MAX  PRESSURE  ******************* 
0*************  eXCEH'  for  option  2  &  4.  PRESSURE  GENERATION  *********** 
0*************  assuming  PCHTMX  IS  IN  SCALED  UNITS  ********************* 
0********************************************************************** 

CALL  CLEAR 

DF  (GCTYP  .EQ.  1)  .OR.  (ICTYP  .EQ.  3)  .OR.  (ICTYP  .EQ.  5))  THEN 
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HLFRAC  =  1.  -  A3  (43)/(PCHTMX*PRSTR) 

WRITE  (*,  6020)  A3  (43).  PCHTMX*PRSTR,  HLFRAC 
6020  FORMAT(///.5X,”''*  Based  on  the  following  pressure  infoimation:’, 
l/.SX.’Observed  Maximum  Pressure  (MPa)  value  of  =’f20.10, 

2/,5X, ’Maximum  Theoretical  Pressure  (MPa)  value  of  =’,F20.10, 

3//.5X,’the  current  heat  loss  fraction  is:  ’,F12.5, 

4//,10X, ’Enter  a  different  value?  (Yes=l.  No  =  2)’) 

READ  (*.  *)  ILOSS 
IF  (ILOSS  .EQ.  2)  GO  TO  1 160 
ELSE 

HLFRAC  =  0.0 
CALL  CLEAR 
WRITE  (*,  6030) 

6030  FORMAT(///3X,’For  the  pressure  generation  option  (Opt  2)  or’, 
l/,5X,’the  interrupted  burner  option  (Opt  4).  a  heat  loss’, 

2/,SX,’fraction  must  be  entered.  The  heat  loss  fraction  is  in’, 

3/,5X,’the  range  of  0.0  to  1.0.  For  example,  a  value  of  0.1’, 

4/,5X,’means  10%  of  the  total  energy  will  be  considered  lost’, 

5/,SX,’as  heat  to  the  chamber  wall  during  the  calculation.’) 

END  IF 

WRITE  (*,  6040) 

6040  FORMAT(///,5X, ’Enter  the  value  for  the  heat  loss  factor.’ 

1/,5X,’A  decimal  between  0.0  and  1.0’) 

READ  (*.  *)  HLFRAC 
1160  CONTINUE 

PCHAMX  =  (1.0  •  HLFRAO*PCHTMX 
C 

C***  Compute  maximum  chamber  temperature  WITH  heat  loss  -  "TCHAMX” 

C 

TCHAMX  =  PCHAMX*BTM/(CH2  +  SH2  +  AMRGCG) 

C 

C***  Solve  for  maximum  cumulative  heat  loss  "QWMAX" 

C 

BTM  =  CH3  +  SH3  +  AMCVCG 

C********  TOTAL  HEAT  LOSS  ADJUSTED  FOR  ELECTRICAL  ENERGY  *•*♦*<■•♦***** 
IF  OCTYP  .EQ.  5)  THEN 

QWMAX  =  CAPEO  +  A3  (30)*1000000./(4.184*SERSCL*SMSSCL)  -  BTM*TCHAMX 
ELSE 

QWMAX  =  CAPEO  ■  BTM*TCHAMX 
END  IF 

C*************  LINES  ABOVE  ADDED  TO  HANDLE  THE  ETC  CASE  *************** 

C  •<■**♦******  line  below  IS  THE  ORIGINAL  CODING  *<■••*•***<•■****•**•***** 

C  QWMAX  =  CAPEO  -  BTM*TCHAMX 
C 

^*4i4i4>«4ii»«*«*******4i**i|i4i»**4r4r****4i4i****-»«**4i***4i****i|i*4i*4>4i4i*4i4i4>4i*4i*4i4i*4i«* 

^***4i* 

Q*****tit*****t,t,  Compute  Dimensional  Heat  Loss  Quantities  *♦•♦»*****•**** 
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o  n  o 


c 


TMXP  =  TRSTR*TCHTMX 
TAMXP  =  TRSTR*TCHAMX 
PMXP  =  PRSTR*PCHTMX 
PAMXP  =  PRSTR'PCHAMX 
QWMXP  =  SERSCL*SMSSCL*QWMAX 
C 

WRITE  (11,  6050)  PMXP.  TMXP.  HLFRAC.  QWMXP,  PAMXP.  TAMXP 
C 

6050  FORMAT(//.5X.’ . .  Maximum  Chamber  Propenics  are  ******** 

lySX. Theoretical  Maximum  Chamber  Pressure  (MPa)  =’,E16.8 
2 y5X. Theoretical  Maximum  Chamber  Temperature  (deg  K)  =’.E16.8 
3y5X.’  ****  Assuming  a  Heat-Loss  Fraction  =*,F10.3 
4y5X. 'Maximum  Total  Heat  Loss  from  Chamber  (cal)  =’,E16.8 
5y5X. 'Maximum  Chamber  Pressure  (MPa)  w/Hcat  Loss  =',E16.8 
bj'SX. 'Maximum  Chamber  Temperature  (deg  K)  w/Hcat  Loss  =',E16.8//) 

C 


c-*** 

EfjD  OF  HEAT  LOSS  COMPUTATION  ********************** 

O***** 

. . •.•••****•*••*•***•*••****••***************************** 

o*«*** 

C***********  Set  Value  of  "Xi"  =  l.O  for  Each  Layer  (Unbumed)  ********* 

C . 

O************************  [Xi=(SMS/SMSO)ij  ***************************** 
C***** 


0** ******* ************************************************************** 


C 

DO  1170  I  =  1.  NTL 
XI  (I)  =  1.0 
1170  CONTINUE 
C 

o*********************************************************************** 

C*..** 

c 

c********  COMPUTATION  DECISION  BASED  ON  VALUE  OF  "ICTYP'  *************** 

C***** 

C 

c*********************************************************************** 

C**.** 

C****  COMPlTfATION  OF  SYNTHETIC  "P-T"  CURVE  FROM  KNOWN  BURNING  RATES 


c 

IF  GCTYP  .EQ.  2)  CALL  PTGEN 
C 

Qt^**^i^m*********************i*i*********m***************ik***!ti****>k*»i>ni>**>ti* 

^4i4t4ii|i4i 

c****  COMPUTATION  OF  BURNING  RATES  FROM  GIVEN  CHAMBER  "P-T"  CURVE  ****** 

Q***^Hi 

Q**************^*  ALSO  SURFACE  AREA  COMPUTATION  ************************ 

Q^t**4^*^^*^t‘**************************************>t‘’^********************‘*^^* 

Q4t*4<«« 

c 


IF  aCTYP  .NE.  2)  CALL  BRRED  (Al) 


^  *  4>  *  *  *  «  *  4>  *  *  *  4t  *  *  «  *  4> «  «  *  «  4i  *  «  *  *  *  *1#  «  4i  4i  *  itt  4ii»  <1 4i  4iit<  4i  itmiiti  Hiiti  i|>  i|<  %  4i  41  <1  <1 4i  *  4i  4i  *  4i  :ti  *  4i «  4t  4i]ti  *  4i  * 

(^*4<4<*4<ii'*****4i*4i«**4<4<*  REWRITING  THE  .INF  FILE  ************************** 

Q^^m^t^^^l**^l*^^*^l^l^^^^^^l^^^ntl^****^l^ll^>lt^Htltl*******^l^t^^****^l*<t‘********************m* 


OPEN  (UNIT  =  17.  FILE  =  FINF) 

1180  CONTINUE 
DO  11901  =  1.6 
WRITE  (17.  6060)  A2  0) 

6060  FORMAT(A80) 

1190  CONTINUE 
DO  1200  I  =  1.  20 
WRITE  (17.  6070)  Al  0) 

6070  FORMAT(A20) 

1200  CONTINUE 
DO  12101=  1.  100 
WRITE  (17.  *)  A3  (I) 

1210  CONTINUE 
DO  12201  =  1.  11 
DO  1230  J=  1.  15 
DO  1240  K=  1.5 
WRITE  (17.  *)  PX  (I.  J.  K) 

1240  CONTINUE 
1230  CONTINUE 
1220  CONTINUE 
CLOSE  (UNIT  =  17) 

CLOSE  (UNIT=  11) 

CLOSE  (UNIT=  13) 

STOP 

END 

C 

Q  «  (t  *  «r  *  *  «  *  14  »  *  4i *  *14  41  *  *  *  *  *  *  «  *  «  *  » lit  *  itiitiiti  *  *  itr *  4i  4i «  4.  *  Hi  4i  41 «  4iiti  4i  4. 4114  4, 14  4i  4i  4, 41 4i  4, 4, 4. 4, 4, 4, 4, 4, 4, 4, 4, 

c***** 

^»4>4^4l4>4l4i4'*4i*4i**4l*4i***4i4<«4^*4i4^**4i*4^4i4^4l*4i4l4l4l4l4i*4i4^4^4^4>4^*4<4l4i4l4l4l4l4i4l4l**4i4l4I4l4l4l4I4lV 
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c**********  END  OF  "MAIN"  CONTROL  PROGRAM  **♦*■(■*♦********•************* 

^  4>  *  4i  *  «  *  «  *  «  Kiiii  *  Hi  i|ii|i  «■  *  Hi*  *  *  *  ««  *  «  *  *  Hr  *  Hi  *  Id  4iiti4>  4>  Di  4i «  «  *  4i  *  Hiiti  *  »«  4i4i  *  4i  *  « ■)<  4>  *  *  *  *  *  *  *  4»t<  *  *  *  *  0 
^*41  Id** 

Q*********************************************************************** 

^***** 

c 


SUBROUTINE  PTGEN 


^*********************************************************************** 

Q***** 

C**  This  routine  generates  chamber  pressure  as  a  function  of  time  when 

(^***** 


C***  burning  rates  have  been  specified  in  Subroutine  BURNRT 

Q***** 


Q*********************************************************************** 


Q***** 


COMMON  /ARRAYS/  A3  (100),  PX  (11,  15.  5) 
COMMON  /ETC/  EE  (1000) 


COMMON  /CONTRL/  NTL,  CHVOL.  HLFRAC,  DT,  NMAX,  CONVRG,  ICTYP 
COMMON  /FIXED/  CHI,  CH2.  CH3,  CAPEO,  QWMAX,  PCHAMX 
COMMON  /SUMS/  SHI,  SH2,  SH3.  SH4 
COMMON  /NVALUEy  RHOSRN,  ASURN,  DPTHBN,  TPMRGM 
COMMON  /SOLUT/  TIME  (1000),  PCH  (1000),  RBR 

1  (1000),  TPMR  (1000),  SMS  (1000) 

2  ,  RHOS  (1000),  TCH  (1000),  DPTHB  (1000), 

3  ASUR  (1000),  LYR  (1000) 

COMMON  /SCALE/  RHOSTR,  TRSTR,  PRSTR,  RBRSTR,  VOLSTR,  SURSTR,  ELSTR 
1  .  SMSSCL,  CVRSCL,  SERSCL,  TIMSCL 
COMMON  /SOLIDL/  SMSOL  (15),  XI  (15) 

COMMON  /AVEPROP/  RHOSAV  (15),  SESOAV  (15).  SBCGAV  (15),  RGCGAV  (15). 

1  CVCGAV  (15) 

COMMON  AGNITOR/  SMSIG,  SESIG,  RHOSIG,  WTMIG.  SBIG,  RGIG,  CVIG 
COMMON  /AIR/  SMSA,  WTMA,  SBA,  RGA,  CVA 
COMMON  /METH/  IMOD 


Q*********************************************************************** 


Q***** 


C**  Begin  burning  initial  (outside)  layer:  J  =  1 
C 

J=  1 


Q*********************************************************************** 

Q***** 

(^**********  Compute  Sums  Which  Remain  Constant  in  Layer  "J"  (=1)  ******* 

^***** 

C****  CALL  SHEVAL  (J.NTL)  ISH1,SH2.SH3.SH4  returned  in  COMMON/SUMS)  * 
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^■N4<4>4>* 

Q  *41 «  *  *  *  4>  4i  *  Hi  4i «  *41  *  «  *  *1(1  *  *  *41  *  Hiiti  it>  *  iX  «  4i «  «  «  «  *  *  4i  4>  *  4>  *  *  «  *  *  *  *  *  Hi  *  «  *  *  i|«t>  *  Hi  4»t<  «>  «t  4>  *  «  *  *  « 

^4i4i4i4>4> 

c 

CAIX  SHEVAL  (J.  NTL) 

C 

^4<  4>  4i  4>  4<  4<  4i  4<  4>  *  4<  *  4i  4>  4i  4i  4i  4i  4i  *  4i  *  4i  4i  4t  41 4<  4>  4<  4<  4i  41 4i  4i  4<  4<  4i  4>  4i  4i  4>  4>  4>  4i  4i  4i  4i  4i  *  4<  4>  4«X  4<  *  *  4<  4>  4>  4>  4<  4>  4>  4<  4i  4i  4i  *  4i  4i  4i 
^4i*4>4>4i 

C********  COMPUTE  INITIAL  CONDITIONS  IN  CHAMBER  WITH  IGNITOR  CONSUMED 

Q**4i*4i 

^*4i4i44i4i4i4i4i4<4i4<4c4<4'4'4<4>4<4i4>4i4>4<4<4i4i4<**4i*4i4>***4>*4i4>4i4'*4i4>4>4>4<*4'***4i*4>4i4>*4<4<4<4<4i4<4'4>4<4>4i 

^4i4i4i4i4i 


WRITE  (11,  6000) 

6000  FORMAT(/,’  **  Results:  Computation  of  Chamber’ 

1  Pressure  from  a  Known  Burning  Rate  **'J/ 

2  .3x.’***  N  LAYER  ***  TIME(ms)  ***  PCH(MPa)  ***  TPMR(gm)’ 

3  ***  RBR(cm/s)  ***  ASUR(cm2)  ***  TCH(degK)  *'*'*  DEPTHB(cm)  **** 
4J) 


C***  COMPUTE  INITIAL  VALUES  OF  "PCH"  AND  "TCH’’  BASED  ON  "XIN’  =1.0  *** 
C 

XIN  =  1.0 
C 

^  4i  4>  4<  4<  4<  4i  4<  *  4i  4i  4<  4>  4i  *  4i  4<  4<  *  *  *  4>  4<  4<  4<  4<  4>  *  4<  4i  4>  4<  4<  *  41 4>  4<  4>  4>  4<  4<  4<  4>  4i  4>  4<  4i  4i  4>  4>  4>  4i  4<  4<  4>  *  4<  4<  4>  4<  4>  4<  4>  4>  4<  4>  4>  4<  4' 4i  4>  4t 
(^4>4i4i4i4> 

C**  Call  "PTCALC"  Subroutine  to  get  initial  values  of  chamber  pressure  a 
end 

C**  temperature  PLUS  the  initial  surface  area  AND  all  integrals 
C 


CALL  PTCALC  (J.  XIN.  PCHN,  TCHN,  QWN) 


^4r4<4<4i4>4>4<4>4>*4>4'*4<4>4'4>**4c4i4i4i4i**4i4<4i4'4>4'*4<4'4<4c4>4<4>* 


C***  COMPUTE  INITIAL  BURNING  RATE  *** 
C 


CALL  BURNRT  (PCHN.  1,  RBRN; 


^  *  4c  4r  4i  4t  41 4<  4<  4<  4>  4<  4<  4<  41 41 4<  4>  4<  4>  4i  4- 4i  4i  4i  4i  4r  4^  4>  4i  4»X  *  4<  4>  4<  4>  4<  41 4t  4<  4c 


c 


PCH  (1)  =  PCHN 
TCH  (1)  =  TCHN 
RHOS  (1)  =  PX  (4.  J,  l)/RHOSTR 
C 

SMS  (1)  =  SMSOL  (J) 

RBR  (1)  =  RBRN 
ASUR  (1)  =  ASURN 
DPTHB  (1)  =  DPTHBN 
LYR  (1)  =  J 


4c  4c 
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TIME  (1)  =  0.0 
CALL  OUTPUT  (1) 


^  4i  4i  4i  *  «  4i  4i  4i  *  *  *  #  «  *1(1 4ii|i  *  *  «  *  Hi  Hi «  41 «  4(  4i  41  *  «  «  *  41  *  4i  *  *  4ii|i  **  III  itr « itt  III  i|> » itiiti  *  «  «  *  4i  *  *  *  «  *  4)  *  >t<  %  4>  *  4»l<  % 
^4i4i4i4i4i 

C********  BEGIN  TIME  INTEGRATION  TO  COMPUl'E  CHAMBER  PRESSURE  (TIME) 

^4i4i4i4i4i 

^  4i  4i  4i  *  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  *  4i  4i  Hi  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 
Q4i4i4i4i4i 

c 

N=  1 


C 

C**  Initial  guess  for  SMSN  and  PCHN 
C  (only  used  to  get  average  properties) 
C 


SMSN  =  SMS  (N) 
PCHN  =  PCH  (N) 


^  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  *  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  *  41 4i  4i  4i  4i  4i  41 4i  4i  4<  4i  4i  4i  4i  4i  *  4i  4i  4i 


C********  "490"  LOOP  COMPUTES  CHAMBER  PRESSURE  vs  TIME  ********** 


^4i4i4i4i4i4i4i4i4i4i*4i*i)i*4i4i4i4i4i*4i*4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4ii|i4i4i4i4i4i4<4i4i4i4i4i4i4i4i4i4i4i4i4i 


c 

1000  CONTINUE 
C 


N  =  N+  1 

^4i4i4i4i«i*4i**4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i*4i4i*4i  41**41*4' 4i4i4<*4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4<4i4i4i*4i4i*4i4i4i 


C**  PRINT  TO  TELL  IF  SOMETHING  IS  HAPPENING  **  [do  NOT  do  this  on  Cray]* 
(^4.4<4i4i4'4'4<4'4i4'*4>4i4'4i4<4'*  QBERLE  12/25/91  *************  [Koolcor  30  Dec  91  ]*** 

^  4i  i4  4i  4i  4>  41 4i  4i  *  4>  4i  4>  4<  4i  4' 4i  4i  4i  4i  4i  *  4' 4"»  *  4i  4<  4>  4i  4>  4>  4<  4>  4i  4>  4i  4i  4i  4i  4i  4>  4i  4i  4>  4' 4i  4i  4i  4i  4i  4i  4>  4i  4i  4<  4<  4' 4i  4<  4i  4<  41 4i  4' 41 41 4i  4i  4i  4i  * 

CALL  CLEAR 

lETY  =  INT  (A3  (31)  +  .5) 

IF  (OETY  .EQ.  1)  .OR.  (lETY  .EQ.  2))  THEN 
WRITE  (*,  ♦)  ’  Using  Constant  Values’ 

ELSE 


WRITE  (*,*)’  Using  Integrals’ 

END  IF 

WRITE  (*,  6010)  N,  PCH  (N  -  1)*PRSTR.  TIME  (N  -  1)*TIMSCL 
6010  FORMAT(///^X, ’Pressure  Generation  Step:  ’,I4y 
15X,’**  Previous  Step:  P(MPa)  =’.F10.4. 

23X,’and  Time  (millisec)  =’J=9.3) 

IF  (N  .GT.  NMAX)  GO  TO  1010 
TIME  (N)  =  TIME  (N  -  1)  +  DT 
C 

^  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  *  *  4i  4i  41 41 4i  4i  4i  41 4i  41 4i  4i  4i  4i  4i  4i  4i  4>  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4<  4[  4i  4i  4i  4i  41 4i  41 4i  41 

C****  begin  iteration  for  value  of  "PCHN"  AT  TIME  STEP  "N"  ****** 

Q  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  41  *  *  4>  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  *  4i  4i  41 4i  4i  4i  4i  4>  4i  4>  4i  41 4<  4i  4i  4- 4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 


C**  Parameters  ending  with  "--Nl"  are  previous  converged  values 


4>4i4i4i 
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C  at  last  time  step  "N-1" 

C**  Parameters  ending  with  "--N"  are  current  iterative  values 
C  at  current  time  step  "N" 

Q  Hi  **  4i  ***  4>  4<  4<  *  *41 O*  **>ti  4i***4>  ***  Ki***  4<  4"K  **  4"*  *  4'<l<  4<  * 


c 

C**  Set  Last  Values  of  RHOS,  ASUR  and  RBR 
C 

RHOSNl  =  RHOS  (N  -  1) 

ASURNl  =  ASUR  (N  -  1) 

RBRNl  =  RBR  (N  -  1) 

C 

C**  Set  Last  Value  of  Mass  (in  Layer  "J")  Remaining  in  Chamber 
C 


SMSNl  =  SMS  (N  -  1) 

C 

C*********  Begin  Iterative  "500"  Loop  to  Find  PCH(N):  ******* 
C****  (Loop  will  try  20  times  for  convergence,  KN  <=  20)  ***** 
C 


IDONE  =  0 


KN  =  0 


FRACr  =  1.0 


C 

1020  CONTINUE 
C 

IF  (KN  .LE.  20  .AND.  IDONE  .NE.  1)  THEN 
C 

KN=  KN+  1 

PCHLAS  =  PCHN 

CALL  BURNRT  (PCHN.  J,  RBRN) 

C 

XIN  =  SMSN/SMSOL  (J) 

C 

JPl  =  J  +  1 
SUMI  =  0.0 
C 

IF  (JPl  .LE.  NTL)  THEN 
DO  1030  I  =  JPl,  NTL 
SUMI  =  SUMI  +  SMSOL  (I) 

1030  CONTINUE 
END  IF 
C 

TPMRN  =  SUMI  +  SMSN 
TPMRGM  =  TPMRN*SMSSCL 


Q*****4i**i|i*i|i*4<4ii|i*i|i4i4i*4i*4>*4<*il<**4<4<**4<4i4<*****4i*4<4>**4>4<***4>4i****4>*4i4'*4>**i|<*** 

C**  Call  "DEPTH-BURNED"  Subroutine  to  get  Surface  area  +  Integrals 

^***111***111 4t*4ii|i4i4<4>4>*4<4>*4i*****4i****4i4>4i4i4i4i*4i>l<4'4'<)>*4>*4<**4<**4<4<*4<**4<<l<  I********** 


c 
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CALL  DEPTH  (TPMRGM.  J,  1.  DEPTHCM,  ASURCM2) 
C 

DPTHBN  =  DEPTHCM/ELSTR 
ASURN  =  ASURCM2/SURSTR 
RHOSN  =  (PX  (4,  J.  1)  +  (PX  (4.  J.  2)  -  PX  (4,  J,  1))* 

1  ((DEPTHCM-PX  (1.  J.  1))/PX(1.  J.  2)))/RHOSTR 
C 


c 


c 


DELSMS  =  FRACT*DT*(RHOSN*ASlIRN*RBRN 
+  RHOSN1*ASURN1*RBRN1)/2.0 
SMSN  =  SMSNl  -  DELSMS 


C***  Must  Check  for  SMSN  <  0.0  =>  Layer  has  Burned  Out 
C 


IF  (SMSN  .GE.  0.00)  THEN 
C 


C**  Layer  "J"  has  not  yet  Burned  Out 
C 


FRACT=  1.0 


XIN  =  SMSN/SMSOL  (J) 

C 

C***  COMPUTE  VALUES  OF  "PCHN"  AND  "TCHN"  FOR  THIS  VALUE  OF  "XIN" 

C 

CALL  PTCALC  (J,  XIN.  PCHN.  TCHN,  QWN) 

IF  (ABS  ((PCHN  -  PCHLAS)/PCHLAS)  .LT.  CONVRG  .OR.  KN  .GE.  20)  THEN 
PCH  (N)  =  PCHN 
TCH  (N)  =  TCHN 
SMS  (N)  =  SMSN 
C 


RHOS  (N)  =  RHOSN 
RBR  (N)  =  RBRN 
ASUR  (N)  =  ASURN 
DPTHB  (N)  =  DPTHBN 
TPMR  (N)  =  TPMRN 
LYR  (N)  =  J 


^  4i  *  4iiti  *  ifiitiili  <1 4>  4i  *<)■  Hi  <■  4<  4i  >l<  4i  4>  ***  4>  *  4>  *  *41  *  III  4»l>  III  4»|c  4>  1(1  it<  it<  *  **  *  4>  ******  <1 


C**  After  successful  completion  of  step,  load  "5"  values  into  "4" 

C 

DO  1040  KV  =  2,  11 
PX  (KV.  J.  4)  =  PX  (KV.  J.  5) 

1040  CONTINUE 

^**************************************************************** 
CALL  OUTPUT  (N) 

IDONE=  1 
C 
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ELSE 
END  IF 
C 

ELSE 

C 

^  «  41 4>  4<  *  4>  *  «  Di  4>  Hi  *  Hi  *  Hi  *41 «  Hi  *  *  *  *  Hull «  4i  *  4>  *1(1  *  *  4ii»  *  4i  4>  *  *  *  4ii|i  *41 «  Hull  *  «  « iK  4>  *  *  4«t>  4> 

^*****************  Layer  "j"  has  Burned  Out  •*••****•***•******** 
C****  Must  Reset  Sums  and  Switch  Layers  to  J  =  J  +  1  *********** 
^**************************************************************** 
C**  COMPUTE  PROPERTIES  AT  BURNOUT  OF  LAYER  "J  ” 

C 

XIN  =  0.0 
C 

CALL  PTCALC  (J,  XIN,  PCHBO,  TCHBO,  QWBO) 

C 

C**  Print/Write  BURNOUT  VALUES  ** 

C 

TIMBOP  =:  TIME  (N)*TIMSCL 
PCHBOP  =  PCHBO*PRSTR 
TCHBOP  =  TCHBO*TRSTR 
DPTHOP  =  DPTHBN*ELSTR 
C 

WRITE  (11.  6020)  J,  N,  TIMBOP.  PCHBOP.  TCHBOP.  DPTHOP 
6020  FORMAT(/*  •**  PROPELLANT  LAYER  J=  M2.’  has  Burned  ’ 

1  .’out  on  Step  N=  ’.15.’  Before  TIME  (millisec)  of  ’.E16.8y 

2  .15X.’Chamber  Pressure  (MPa)  at  Burnout  =’JE16.8y 

3  .15X. 'Chamber  Temperature  (deg  K)  at  Burnout  =’£16.8./ 

4  .ISX.’Depth  of  Layer  (cm)  at  Burnout  =’.E16.8) 

C 

C"""  Set  Final  Value  of  "Xi"  for  this  Layer  "J" 

C 

XI  (J)  =  0.0 

c 

C**  SET  INDEX  OF  NEW  LAYER  "J" 

C 

J  =  J  +  1 
C 

C**  CHECK  ON  TOTAL  PROPELLANT  BURNOUT 
C 

IF  (J  .GT.  NTL)  GO  TO  1010 
C 

C*"*  Set  Properties  for  fractional  time  step  integration 
C 

FRACT  =  (1.0  -  ABS  (SMSN)/(SMSN1  -  SMSN)) 

SMSNO  =  SMSN 
KN  =  1 
C 

SMSNl  =  SMSOL  (J) 
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SMSN  =  SMSOL  (J)  +  SMSNO 
RHOSNl  =  PX  (4,  J.  l)/RHOSTR 
CALL  BURNRT  (PCHBO,  J.  RBNl) 

C 

C*""  Compute  total  propellant  mass  remaining  in  chamber 
C  when  "old  layer  J"  burned  out 
C 

SUMI  =  0. 

DO  1050  I  =  1,  NTL 
SUM!  =  SUMI  +  XI  (I)*SMSOL  0) 

1050  CONTINUE 
C 

TPMRGM  =  SUMI*SMSSCL 


c**-  Call  "DEPTH-BURNED"  Subroutine  to  get  Surface  area  (ONLY) 

Q^l^lt^,t^i4l>n,*^Li|l<ttt,t^>Hl*m******’¥!tl*************************>****************^l** 

c 

CALL  DEPTH  (TPMRGM.  J.  2.  DEPTHCM,  ASURCM2) 

ASURNl  =  ASURCM2/SURSTR 
C 

^  *  *41  Jit  4i « 4t  41  itiiti «  4i  4>  i|> «  4i  «i  4t «  *  *  *  *  **  *  A  «  4i «  4i  i|>  Hi  %  4>  i|> «  «  4i  i|<  4i  *  4>  *  «  *  *  III  *  Hi  i*«tt  *  *  i|>  *  1*1  *  i|»ti «  «  *  *  *  * 

^4i4i4i4i4i 

C*******  Now  Reset  All  Sums  Which  Remain  Constant  in  New  Layer  "J"  *"*"*■** 

^4i4i4i4i4i 

c****  CALL  SHEVAL  (JJsrTL)  [SH1,SH2,SH3.SH4  returned  in  COMMON/SUMS]  * 

^4i*4i4i4i 

^  4i  4i  4>  4i  4i  4<  4i  4i  *  4>  4<  4i  4i  4i  4i  *  4  4i  4i  4i  4i  4i  4i  4i  4<  Hi*  *  4i  4i  4  4i  4i  4i  *  *  4<  4i  If  4i  4<  41  *  4i  41 4i  *  4i  4i  4i  *  4i  4i  4i  4i  4i  *  *  *  4i  4i  4i  *  4i  4>  4i  4i  4i  4i  *  4i 
^4i4i4i4>4i 

c 

CALL  SHEVAL  (J.  NTL) 

C 

^  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  If  If  If  4i  4i  4>  If  4>  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4  If  4i  If  4i  4>  4i  If  If  4i  4i  4i  If  If  4>  If  If  If  4i  If  4  4i  4i  4i  4i  4i  41 41 4i  If  4i  If  4i  4i  4i 

^414444 

c 

END  IF 
C 

C 

C 

C 


GO  TO  1020 
ELSE 

GO  TO  1000 
END  IF 


1010  CONTINUE 
C 

RETURN 
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END 


C 

^  «  *41 4i  *  *  *  *  *  *  *  *  *  Hi  *  *  *  *  III  <1  *  «  *  4ii|>  Di  *  ■!>  *  *  *  « >)>  <!"•>  *  *  *  >li  *  *  *  *  *  *  *  *  *  ■*"•"<<  *  <•>  *  *  *4:  *  4' *  I*  <■  *  * 

^4i4i4i4i* 


SUBROUTINE  BRRED  (Al) 


^  4i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4<  4<  4i  4>  4<  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  4>  4>  4<  41 4>  4i  4>  4<  4i  4i  4i  4i  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 


Q4i4i4i4i4i 


C**  This  routine  computes  effective  linear  regression  rates  based  on  *** 

^4i4i*4>4i 


C**  a  given  chamber  pressure  as  a  function  of  time  (from  UNIT  13)  ** 

^4i4i**4i 


^**4i*4i*4i*4i*4i4i4i4i4i4i4i4i4i4i*4>*4i4i4>4i4i4i4i4>4i4>*4i4i4i4i4i4i4i4i4i4<4i4i4i4i4i4i4i4i4i4i4i4i4>4>4>4i4i4i4i4i4i4i4i*4i*4> 


^4i*4i4i4i 

COMMON  /ARRAYS/  A3  (100),  PX  (1 1.  15.  5) 

COMMON  /ETC/  EE  (1000) 

C 

COMMON  /CONTRL/  NTL,  CHVOL,  HLFRAC,  DT.  NMAX,  CONVRG,  ICTYP 
COMMON  /FIXED/  CHI,  CH2,  CH3.  CAPEO,  QWMAX,  PCHAMX 
COMMON  /SUMS/  SHI,  SH2.  SH3,  SH4 
COMMON  /NVALUE/  RHOSRN.  ASURN,  DPTHBN,  TPMRGM 
COMMON  /SOLUT/  TIME  (1000),  PCH  (1000),  RBR 

1  (1000),  TPMR  (1000),  SMS  (1000) 

2  .  RHOS  (1000),  TCH  (1000),  DPTHB  (1000), 

3  ASUR  (1000),  LYR  (1000) 

COMMON  /SCALE/  RHOSTR,  TRSTR,  PRSTR.  RBRSTR,  VOLSTR,  SURSTR,  ELSTR 
1  ,  SMSSCL,  CVRSCL,  SERSCL,  TIMSCL 
COMMON  /SOLIDL/  SMSOL  (15),  XI  (15) 

COMMON /A VEPROP/  RHOSAV  (15).  SESOAV  (15).  SBCGAV  (15).  RGCGAV  (15), 

1  CVCGAV  (15) 

COMMON  /IGNITOR/  SMSIG,  SESIG,  RHOSIG,  WTMIG,  SBIG,  RGIG,  CVIG 
COMMON  /AIR/  SMSA,  WTMA,  SBA,  RGA,  CVA 
COMMON  /METH/  IMOD 


DIMENSION  NLOW  (15).  NHIH  (15) 
CHARACTER*20  Al  (20) 


^4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4>  4>  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4< 


1000  CONTINUE 

OPEN  (UNIT  =  13,  FILE  =  Al  (14).  STATUS  =  ’OLD’,  ERR  =  1010) 
REWIND  (13) 

GO  TO  1020 
1010  CONTINUE 
CALL  CLEAR 

WRITE  (*,  *)  ’The  Pressure-Time  File  Does  NOT  Exist’ 
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WRITE  (*,  ♦)  ’Enter  a  New  File  Name  For  The  P-T  Data’ 
READ  (*,  5000)  A1  (14) 

5000  FORMAT(A20) 

GO  TO  1000 
1020  CONTINUE 


Q  «  Hi  *  4!  4> «  «  m  *  *  4i  *  1|I «  *  *  Diiti  «  «  «  «  4t  *  «  4ii|i  *  *  *  *  *  *  *  Xcitcitc  *  *  m  4»t< «  »<*  *  *  Hi*  >t<  >*«•<  *  4<  >•<  *  «  4>  4> 


Q*iK4i4i4c 


c 


J=  1 


^*1(1*  DciX  4>  *  *  *  *  *  4i  *  *  *  4i  *  *  *  >)<  *  A*  *  «  OK*  *  «  *  4>  *  *  *  *  *  *  *  *  4<  *  %  «  4< «  «  *  4«t<  O  *  «  4> «  *  4>  *  *  *  *  4»<<  %  4»l>  4<  *  *  * 
^0*0410 

C**********  Compute  Sums  Which  Remain  Constant  in  Layer  "J"  (=1)  ******* 

^4>4<*4i* 

C****  CALL  SHEVAL  (JJMTL)  [SH1.SH2,SH3.SH4  returned  in  COMMON/SUMS]  * 

^4i4i4'04i 

^4i4<004i4<4>4<4<4>4'4>0*4>04<4i04i4<4i4i4<4<4<4<04<004<04'4>4>4<4>00>i<4>4>4i4i4t04>4>4<4<04'4i04>4>4>4>4<04<4i4<4>04<4>4i00 

(|^*004i4< 

c 


CALL  SHEVAL  (J.  NTL) 

C 

^  4i  *  *  4>  4<  4<  4i  4i  4i  O  4i  4t  4<  4<  4<  4<  4<  *  4<  O  4<  4<  4i  4<  4i  4<  41 0  O  4<  4<  4<  4i  O  *  4i  4i  4<  4>  4<  4c  4' 4>  4t  4>  4>  4<  4<  4<  4>  4>  4<  41 4<  4<  4<  4i  4<  4i  4<  4i  4>  4>  4>  4>  4<  4>  4>  4<  *  4> 

Q4i4c04<4c 

C********  COMPUTE  INITIAL  CONDITIONS  IN  CHAMBER  WITH  IGNITOR  CONSUMED 

^4>4c4i4c4c 

^  4c  4c  4c  4c  4t  4c  4c  *  4c  4c  4t  4c  4i  *  4c  4c  4i  4c  4c  4c  4i  4c  4c  4c  #>  4c  4c  4c  4c  4c  4c  4c  4c  cc:  4c  4c  4i  4c  4c  4i  4i  4c  4i  4c  4<  4c  41 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4i  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4' 

^4c**** 


IF  (ICTYP  .NE.  3)  THEN 
WRITE  (11,  6000) 

( (X)0  FORMAT(/,’  **  Results:  Deduced  Burning  Rates  Based’ 

1  ,’  on  a  given  Chamber  Pressure  vs.  Time  **'JI 

2  .3x,’***  N  *♦*  LAYER  ***  TIME(ms)  ***  PCH(MPa)  ***  TPMR(gm)’ 

3  .’  **•  RBR(cm/s)  ***  ASUR(cm2)  ***  TCH(degK)  ***  DEPTHB(cm)  ***’ 

4J) 

ELSE 

WRITE  (11,  6010) 

6010  FORMAT(/,’  **  Results:  Deduced  Surface  Area  Based’ 

1  ,’  on  a  given  Chamber  Pressure  vs.  Time  **’J/ 

2  ,3x,’***  N  ♦**  LAYER  ***  TIME(ms)  PCH(MPa)  ***  TPMR(gm)’ 

3  ,’  ***  RBR(cm/s)  ***  ASUR(cm2)  ***  TCH(dcgK)  ***  DEPTHB(cm)  **•’ 

4J) 

END  IF 
C 

C***  COMPUTE  INITIAL  VALUES  OF  "PCHN"  AND  "TCHN  "  FOR  "XIN  ”=1.0 
C 

XIN  =  1.0 


c 

^OOO*4c4c4c4c4c4c4c4c4ci4c44cc44cc4O4c4c4c4c*4c4c4i4c4c4c4c4c4c4c4c4cc44c4c4c>4Oc40O0c44c04c4c4c4c4c4c4c4c4c4c4c4c4c4cc44cc44c4c4c4c 


4c  4c 
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Q4<4i4iiti4i 

C**  Call  "PTCALC"  Subroutine  to  get  initial  values  of  chamber  pressure  a 
Cnd 

C**  temperature  PLUS  the  initial  surface  area  AND  all  integrals 
C 

CALL  PTCALC  (J.  XIN,  PCHN,  TCHN.  QWN) 

C 

^  *  4i «  4c «  *  *  «  *  «  «  *  *  i|>  4<  it> «  «  *  «  4<  i|<  *  *  «  4i «  «  ^  #  4. * 

c 

PCH  (1)  =  PCHN 
TCH  (1)  =  TCHN 
RHOS  (1)  =  PX  (4.  J,  l)/RHOSTR 
C 

SMS  (1)  =  SMSOL  (J) 

ASUR  (1)  =  ASURN 
DPTHB  (1)  =  DPTHBN 
LYR  (1)  =  J 
C 

TIME  (1)  =  0.0 
C 

CALL  OUTPUT  (1) 

^  4>  it>  4<  4>  *  i|c  i|<  *  4>  4c  4>  <(c  4>  it<  *  4>  *  etc  4>  etc  4c  *  4i  *  i<>  4<  4c  4<  i|>  etc  c|<  4»l<  III  4<  c^  <<•  4»l<  4>  c<<  4c  4c  4<  4<  4>  4<  4c  4>  4>  >*<  4c  *  41  >t<  4c  4>  4<  4>  4<  4c  4<  4c  i|< 

C**********  FIRST  MUST  DETERMINE  LOCATION  IN  PRESSURE  DATA  *4c4c.»4c4c4c4c4c4c*4c 
C4.4C4C4.4C4C*4.*4C  gQ  THAT  PRESSURE  IS  ALWAYS  ABOVE  IGNITER  PRESSURE  ********* 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

NPNX  =  0 
LNPNX  =  0 
DUMTT  =  0.0 
CALL  CLEAR 
1030  CONTINUE 

READ  (13.  *,  END  =  1040)  DUMT,  DUMP 
NPNX  =  NPNX  +  1 

IF  (DUMP  .LE.  PCH  (1)*PRSTR)  THEN 
LNPNX  =  NPNX 
DUMTT  =  DUMT 
GO  TO  1030 
END  IF 

1040  CONTINUE 

WRITE  (*.  6020)  LNPNX.  DUMTT*1000.  +  A3  (42).  PCH  (1)*PRSTR 
6020  FORMAT(///4X.Tor  the  calculation  to  be  performed  corrccUy*. 
lASX.’all  pressures  must  be  above  the  igniter  pressure.  For'. 

2/.SX.’thc  cunent  data  set  points  had  to  be  deleted  to  obtain’. 

3/.SX.’all  pressures  above  the  igniter  pressure.  Information*. 

4/.SX.’relative  to  the  deleted  data  points  is:’. 

S//3X. ’Number  of  points  deleted  :’.IS. 

6/.5X.’Time  interval  of  deleted  points  (ms):’J^10.5. 

7/.5X.’Ignitcr  Pressure  (MPa) 

PAUSE 
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REWIND  (UNIT  =  13) 

DO  1050  KXK  =  1,  LNPNX 
READ  (13.  *)  DUMT,  DUMP 
1050  CONTINUE 
CALL  CLEAR 


QH,tHH,*>Hitt‘************************************‘**************************'t‘ 

Qm***!* 

C******  BEGIN  COMPUTATION  MASS  REMAINING  IN  LAYER  "J"  (SMSN)  VS.  TIME 

Q  ****  O’**  Id*  **  <1  *  O*  ***********  O**  O*  ^  4> «  *  4>  4"t>  *4' 4> «« lO  **  4>  *  *****  « 

^***** 

c 

N=  I 
C 


C**  Initial  guess  for  SMSN  and  PCHN 
C  (only  used  to  get  average  propenies) 
C 


SMSN  =  SMS  (N) 

PCHN  =  PCH  (N) 

C 

^**************************************************************** 


(^*************  ..49Q..  LOOP  COMPUTES  "SMS"  vs  TIME  **************** 
^**************************************************************** 


C 

1060  CONTINUE 
C 

N  =  N+  1 
C 

IF  (N  .GT.  NMAX)  GO  TO  1070 
C 

Q**************************************************************** 

C**  READ  "PCH(N)"  AND  "T1ME(N)"  FROM  UNIT  13 
C 

C**  NOTE:  It  is  assumed  that  PCH  on  13  has  units  "MPa" 

C**  and  TIME  on  13  has  units  of  "mil-sec" 

C 

^**************************************************************** 
(^**********  IP  OPTION  5.  ELECTRICAL  ENERGY  MUST  BE  READ  **♦**•*•* 
0**********  must  also  CONSIDER  IF  PRESSURE  IS  ••***•**•***•*♦***• 
0**************************************************************** 

IF  OCTYP  .EQ.  5)  THEN 

READ  (13.  •.  END  =  1070,  ERR  =  1070)  DUMT.  DUMP.  XXX.  EEL 
EE  (N)  »  EEL 
ELSE 

READ  (13.  *.  END  =  1070,  ERR  =  1070)  DUMT.  DUMP 
END  IF 
C 


** 
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PCH  (N)  =  DUMP/PRSTR 

^  ift  He  41 4c  41 4c «  *  « I|r  *  4t  4t  *  4|  4i  *  4i  4t «  *  I|i  >t<  I)!  >1' 4>  <>  <•<  4>  4>  4>  *  4<  %  4<  %  4^  4>  4>  *  4«l<  *  *  III  *  4i  4c  3<<  4<:)< 

C***  Compute  Current  Value  of  Cumulative  Heat  Loss  "QWN"  ******** 

C***********  ADD  ELECTRICAL  ENERGY  TO  "QWN"  WILL  BE  ************* 
C4c*4c********  SUBTRACTED  FROM  "QWN"  BACK  FROM  QWCOMP  ***(Huh?)**** 

^4c4<*4<*****4c4c4c4<4c**4c4>4<****4c*4i4c4i4i4c4i4<*4'4<*4c«4>**4c4t4c4>4>4c4<4c4c4c4c4c4c4c4ciic4c4c4c4c4c4c4c 


CALL  QWCOMP  (QWN.  PCH  (N)) 

IF  aCTYP  .EQ.  5)  THEN 

QWN  =  QWN  -  EE  (N)*1000000./(4.184*SERSCL*SMSSCL) 

END  IF 

^4c4>*******4<4<*4i****4>4c4>***4c4i4c4>******4>4<*4<4'4>*4>4i4c4c4c4c4c4c4c4c4>******4c4>4<4'4'4c4< 

(;;4.4<*******4C4<*4>  actual  time  on  unit  13  IS  SEC  ******************** 
^4c4c4c4c4c*****4<******  >VILL  CONVERT  TO  MD^-SEC  ********************** 

Q4c4c4c4c4c4c4c4c*4>4c4c4>*****4i******4c4<4<4<****4<4i*4>*4c4c4c4c4t4c4c4c4c4<4c4c*4c4c4c4c4>*4c4c4c4>4<4c4> 


TIME  (14)  =  DUMT*1000/riMSCL 

CALL  CLEAR 

lETY  =  INT  (A3  (31)  +  .5) 

IF  (lETY  .EQ.  1)  THEN 
WRITE  (*,  ’")  *  Using  Constant  Values’ 
ELSE 


WRITE  (♦.  *)  ’  Using  Integrals* 

END  IF 

WRITE  (*.  6030)  N.  DUMT*1000..  DUMP.  PCH  (1)»PRSTR 
6030  FORMAT(/.5X.’***  BR  Computation  on  Step  =’.14. 
l/.SX.’where  TIME  (millisec)  =’.F9.3. 

25X.’and  Pressure  (MPa)  =’f  10  5. 

3/8X.’NOTE:  Pressure  must  Exceed  Ignitor  Pressure  (MPa)=’ 

4  FI 0.5) 

C 

^4c4<4'**4>*4i*4i4i*4i*****4i4<4i4c*4i4c4i*******4i4'»4c4>4>*4c4c4c4i4c*4i4i4c4i*4i*4c4c4i*4c4>***** 

C*»**  BEGIN  ITERATION  FOR  VALUE  OF  "SMSN"  AT  TIME  STEP  "N"  ****** 

(j^4i4i4i***************4>4c*4c*4c**»>*4i4c***4c********4c4c4c****4c4c4c4c4i4i4c4i4c4c4c4c4c4c4i 

Q4>*4i4>*****  Begin  Iterative  "500"  Loop  to  Find  SMS(N):  ******* 

C****  (Loop  will  try  20  times  for  convergence,  KN  <=  20)  ***** 

C 

IDONE  =  0 
KN  =  0 
C 

1080  CONTINUE 
C 

IF  (KN  .LE.  20  .AND.  IDONE  .NE.  1)  THEN 
C 

KN  =  KN-H 
SMSLAS  =  SMSN 
C 

C***  It  is  assumed  below  that  LAYER  J  is  still  burning 
C 

XIN  =  SMSN/SMSOL  (J) 
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c 

. . **••***•**•••**•*•••**•******•****••** 

C**  Laiesi  value  of  Total  Propellant  Mass  Remaining  in  Chamber  ** 

c 

JPI  =  J  +  1 
SUMl  =  0.0 
C 

IF  (JPI  .LE.  NTL)  THEN 
DO  1090  I  =  JPI.  NTL 
SUMI  =  SUMl  +  SMSOL  (I) 

1090  CONTINUE 
END  IF 
C 

TPMRN  =  SUMl  +  SMSN 
TPMRGM  =  TPMRN*SMSSCL 
C 

. . . . *••*•***.**•**********•**************•*•***** 

C**  Call  "DEPTH-BURNED"  Subroutine  to  get  surface  area  +  all  integrals 

c 

CALL  DEPTH  (TPMRGM.  J.  L  DEPTHCM.  ASURCM2) 

C 

c 

DPTHBN  =  DEPTHCM/ELSTR 
ASURN  =  ASURCM2/SURSTR 
C 

VOLRM  =  PX  (8.  J.  3)  •  PX  (8.  J.  5) 

RATV  =  PX  (8.  J.  5)/PX  (8.  J.  3) 

C 

IF  (RATV  LT.  0.02)  THEN 
SBCGN  =  PX  (6.  J.  l)*RHOSTR 
RGCGN  =  PX  (9.  J.  D/CVRSCL 
CVCGN  =  PX  (10.  J.  1)/CVRSCL 

RHOSRN  =  ((PX  (4.  J.  3)  -  PX  (4.  J.  5))/VOLRM)/RHOSTR 
SESRN  =  ((PX  (1 1.  J.  3)  -  PX  (11.  J.  SJlA'OLRMl/SERSCL 
ELSE  IF  (RATV  GT.  0.98)  THEN 
SBCGN  =  (PX  (6.  J.  SVPX  (8.  J.  5))*RHOSTR 
RGCGN  =  (PX  (9.  J.  5)/PX  (8.  J.  5))/CVRSCL 
CVCGN  =  (PX  (10.  J.  5)/PX  (8.  J.  5))/CVRSCL 
RHOSRN  =  PX  (4.  J.  2)/RHOSTR 
SESRN  =  PX  (II.  J.  2)/SERSCL 
ELSE 

SBCGN  =  (PX  (6.  J.  5)/PX  (8.  J.  5))*RHOSTR 
RGCGN  (PX  (9.  J.  5)/PX  (8.  J.  SJJ/CVRSCL 
CVCGN  =  (PX  OO.  J.  5)/PX  (8.  J.  5))/CVRSCL 
RHOSRN  =  ((PX  (4.  J.  3)  -  PX  (4.  J.  5))/VOLRM)/RHOSTR 
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SESRN  =  ((PX  (1 1,  J.  3)  -  PX  (1 1,  J,  5))A'0LRM)/SERSCL 
END  IF 


C 


AMSESO  =  SMSOL  (J)*SESRN 
AMCVCG  =  SMSOL  (J)*CVCGN 
AMSBCG  =  SMSOL  (J)*SBCGN 
AMRGCG  =  SMSOL  (J)*RGCGN 
AMRHOS  =  SMSOL  (J)/RHOSRN 


c 


Cl  =  CHI  -  SHI  -  AMSBCG 
C2  =  CH2  +  SH2  +  AMRGCG 
C3  =  CH3  +  SH3  +  AMCVCG 
C4  =  CAPEO  -  QWN  -  SH4 


C***  COMPUTE  CURRENT  VALUE  OF  BURNOUT  PRESSURE;  PCHBO 
C 


PCHBON  =  (C2*C4)/(C1*C3) 
C 


C***  Check  to  see  if  PCH(N)  is  less  than  cuncnt  burnout  pressure 
C 


IF  (PCH  (N)  .LE.  PCHBON)  THEN 
C 

QA  =  AMRGCG*AMSESO  +  PCH  (N)*AMCVCG*(AMSBCG  -  AMRHOS) 
QB  =  -  (C2*AMSES0  +  C4*AMRGCG 
1  +  PCH  (N)*(C3*( AMSBCG  -  AMRHOS)  -  C1*AMCVCG)) 

QC  =  C2*C4  -  PCH  (N)*C1*C3 


C 


DISC  =  QB*QB  -  4.0*QA*QC 


IF  (DISC  GE.  0.0)  THEN 
XIN  =  -  (QB  +  SQRT  (DISC))/(2.0*QA) 

ELSE 

n 

WRITE  (1 1,  6040)  N,  KN,  PCH  (N).  PCHBON.  TIME  (N).  QA.  QB.  QC 
6040  FORMAT(///.’  ****  ERROR  ****  "DISC"  IS  NEGATIVE  !!!’. 

1  ’  ON  STEP  N  =M5,’  WHEN  KN  =  M2y.5X.’PCH(N)=’. 

2  EI6.8,’  PCHBON=’.E16.8.’  AND  TIME(N)=\E16.8y. 
35X.’(QA.QB.QC)=’.3E18.8y//) 

STOP 
END  IF 

SMSN  =  SMSOL  (J)*XIN 

IF  (ABS  ((SMSN  -  SMSLAS)/SMSLAS)  .LT.  CONVRG  .OR.  KN  .GE.  20)  THEN 
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c 

C**  Compute  latest  value  of  Chamber  Temperature 
C 


TOP  =  CAPEO  -  QWN  -  SH4  -  AMSES0*X1N 
BTM  =  CH3  +  SH3  -»■  AMCVCG*(1.0  -  XIN) 
TCHN  =  TOP/BTM 


Q  *  «  *  »  «  41  *  *  «  «  *  *  *  *  4<  *  *  *  *  Oi  *  *  O*  *  *  *  4<  *  41  *  <1  *  *  *  *  *  1*1 4> « Ik  *  «  *  *  «  OXoli  *  *  4< «  f  *  4>  4i  it<  >t> 


C**  Latest  value  of  Total  Propellant  Mass  Remaining  in  Chamber  ** 

Q  4<  *  41 4i  4i  4i  4i  Hi*  k  4>  4i  4>  *  4i  4<  41  *  4>  4>  41 4<  *  4i  4i  4<  4i4i  k  4<  4i  X' 4i  Ik  4>  4i  4>  41 4>  4>  4i  4<  4i  4>  *  k  4>  4<  4<  Xi  4<  4<  4i  *  4<  4i  4i  4<  4i  4i  4i  4i  *  * 


c 


JPI  =  J  +  1 
SUMI  =  0.0 
C 

IF  (JPI  .LE.  NTL)  THEN 
DO  11001  =  JPI,  NTL 
SUMI  =  SUMI  +  SMSOL  (I) 
1100  CONTINUE 

END  IF 
C 

TPMRN  =  SUMI  +  SMSN 
TPMRGM  =  TPMRN*SMSSCL 


Q  41 4i  k  Xi  Xi  X|  Ik  k  4i  Ik  X<  4<  Ik  Xi  Ik  *  Xi  X>  4<  X<  xi  4<  41  xi  *  Xi  k  Xi  Ik  Ik  X<  Xi  X>  4<  Ik  X<  X>  Xi  X<  Xi  Ik  41  Ik  Xi  Xc  Ik  Ik  Xi  Ik  X<  X<  X<  Ik  X<  4>  X<  xi  Ik  XI  X>  X<  X>  Xi  X>  X<  Ik  Ik  *  >k  Ik 


C*"*  Call  "DEPTH-BURNED"  Subroutine  to  get  Surface  area  (ONLY) 

^kkkkkkkkkkkkkkkXikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkrkkkkkkkkkXikikkkkkk 

c 

CALL  DEPTH  (TPMRGM.  J.  2.  DEFFHCM,  ASURCM2) 

C 

DPTHBN  =  DEPTHCM/ELSTR 
ASURN  =  ASURCM2/SURSTR 
RHOSN  =  (PX  (4,  J,  1)  +  (PX  (4.  J.  2)  -  PX  (4,  J,  1))* 

1  ((DEPTHOI-PX  (1,  J,  1))/PX(1.  J.  2)))/RHOSTR 

C 


Q<kkXi4ikkkkkXik4iikkkkkkkkXik4iXikkk4ikkkkkkkkkkkkkkkkkkkkkXikkkkkkkkkkkkkkkkkkkk 


TCH  (N)  =  TCWN 
SMS  (N)  =  SMSN 


RHOS  (N)  =  RHOSN 
ASUR  (N)  =  ASURN 
DPTHB  (N)  =  DPTHBN 
TPMR  (N)  =  TPMRN 
LYR(N)  =  J 

^kkkkkkkkkXikXiXikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


C**  After  successful  completion  of  step,  load  "5"  values  into  "4" 
C 


DO  1110  KV  =  2,  11 
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PX  (KV.  J.  4)  =  PX  (KV.  J,  5) 

1110  CONTINUE 

4ii|i  4t  i|i4t  Alii  *  III  4i  4>  <1  <1  *  <1 4i  4i  <1 4i  4t  4i «  *  4>  *  *  *111  *  *  4i  4i «  *  *  <1  *  4>  *  4t «  *  «  *  itiiliiliiti  *  41  Hi  4i  4ntc  4i 

c 

IDONE=  1 
C 

ELSE 
END  IF 


ELSE 


Q4>  4i  4i  4<  4<  4<  *  4<  4i  4<  4i  4>  4<  4<  4<  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4>  4i  4>  4i  4i  4i  *  4<  4<  4i  4i  4i  *  4i  4i  4i  4i  4i  4<  4>  4<  4>  4i  *  *  *  *  *  4i  *  4i  4i  4<  4>  4i  4>  *  4i  4> 
^4i*4i4i4i4<4i4<4i4<4<4<4i4i4<4i4i  LayCF  "J"  haS  Bumed  Out  ox"*'***'*"*'*'*'*'*'*****'*'*** 

C****  Must  Reset  Sums  and  Switch  Layers  to  J  =  J  +  1  f********** 

^  4i  4i  4<  *  *  4<  4<  4<  4i  4<  4i  41 4<  4<  *  4i  4i  4i  *  4i  *  4i  4i  4i  4i  4i  4i  *  4i  *  4i  4<  4i  4i  4i  *  *  4i4i  *  4i  4>  4>  4i  4i  4i  4>  4<  4<  4>  4>  4>  4i  4>  4i  *  4i  4i  4i  4i  4i  4<  4i  4< 

C**  COMPUTE  PROPERTIES  AT  BURNOUT  OF  LAYER  "J" 

C 

XIN  =  0.0 
C 

CALL  PTCALC  (J.  XIN,  PCHBO,  TCHBO.  QWBO) 

C 

C**  Print/Write  BURNOUT  VALUES  ** 

C 

TIMBOP  =  TIME  (N)*TIMSCL 
PCHBOP  =  PCHBO*PRSTR 
TCHBOP  =  TCHBO*TRSTR 
DPTHOP  =  DPTHBN*ELSTR 
C 

WRITE  (11,  6050)  J,  N.  TIMBOP.  PCHBOP,  TCHBOP,  DPTHOP 
6050  FORMATC/*  ***  PROPELLANT  LAYER  J=  *,12.’  has  Bumed  ’ 

1  ,’out  on  Step  N=  ’,15,’  Before  TIME  (milliscc)  of  ’,E16.8y 

2  ,15X,’Chambcr  Pressure  (MPa)  at  Burnout  =’,E16.8y 

3  ,15X,’Chamber  Temperature  (deg  K)  at  Burnout  =’,E16.8y 

4  ,15X,’Depth  of  Layer  (cm)  at  Burnout  =’,E16.8) 

C 

C**  Set  Final  Value  of  "Xi"  for  this  Layer  "J" 

C 

XI  (J)  =  0.0 

c 

C**  SET  INDEX  OF  NEW  LAYER  "J" 

C 

J  =  J+  1 
C 

C**  aiECK  ON  TOTAL  PROPELLANT  BURNOUT 
C 

IF  (J  .GT.  NTL)  GO  TO  1070 
C 

C**  Set  Properties  for  Continuation  of  Integration 


c 


KN=  1 

SMSN  =  SMSOL  (J) 


^  Jti  41*  4i  *  4i  *  Hi  *  «  Hi  41 «  ««  *  4i  *  4>  4;  III «  «  Kt «  Dr  4i  *  «  «  A  «  O  *  *  *  <1  *  *  *  Hi  *  4i>t»K  0  *  >•»•<  4< «  *  *  *  Diili  *  **  IX  *  *  *  4> 
^4i4>4i4i4i 

C*******  Now  Reset  All  Sums  Which  Remain  Constant  in  New  Layer  "J"  ***** 

^4i4>4i4<4> 

C****  CALL  SHEVAL  (J^TTL)  (SH1.SH2.SH3.SH4  returned  in  COMMON/SUMS]  * 

|^4i4i4i4i4i 

Q  4>  4<  4i  4i  4<  *  *  *  4i  4i  4i4<  4i  4i  4i  4i  4<  4i  4i  4i  4i  4>  4>  A  4i  4i  *  **  *  4i  4i  4i  4i  4i  4i  4i  *  4>  4i  4>  4>  4>  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4<  4i  4<  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  41 4i  4i 
Q4i4i4i44i 

c 

CALL  SHEVAL  (J,  NTL) 

C 

^  4iiX  4i  4i  4i  4>  4i  4i  4i  4i  4i  4<  4<  4i  4i  4>  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i  4t  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4<  4i  iX  4i  4i  iX  4i  4i  4i  4i  4i  4< 
^iX4i4iiXiX 

c 

END  IF 
C 

GO  TO  1080 
C 

ELSE 

C 

GO  TO  1060 


END  IF 


1070  CONTINUE 


C***  BEGIN  COMPUTATION  OF  RATE  FROM  SMS(N)  AND  TIME(N) 

C 

NTOT  =  N  -  1 
NTOTl  =  NTOT  -  1 
C 

C  [NOTE:  *EQUAL  TIME  STEPS*  HA\^  BEEN  ASSUMED  HERE] 

C 

WRITE  (11,6060) 

6060  FORMAT(//.’  ***  DEDUCED  BURNING  RATES  ***7/) 

C 

DO  1120  N=  3.  NTOTl 
C 

JLNMl  =  LYR  (N  -  1) 

JLN  =  LYR  (N) 

JLNPl  =  LYR  (N  +  1) 

C 

IF  (JLNMl  .EQ.  JLN  .AND.  JLNPl  .EQ.  JLN)  THEN 
DMSDTN  *  (TPMR  (N  +  1)  -  TPMR  (N  -  1))/(TIME  (N  +  1)  -  TIME  (N  -  1)) 
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ELSE  IF  (JLNMl  .EQ.  JLN  .AND.  JLNPl  .NE.  JLN)  THEN 
DMSDTN  =  (  -  3.0*TPMR  (N)  +  4.0*TPMR  (N  -  1)  -  TPMR  (N  - 
1  2))/(TIME  (N  -  2)  -  TIME  (N)) 

ELSE 

DMSDTN  =  (  -  3.0*TPMR  (N)  +  4.0*TPMR  (N  +  1)  -  TPMR  (N  + 

1  2))/(TIME  (N  +  2)  -  TIME  (N)) 

END  IF 

Q*^l^,<|,^,^,^‘^l**^Hl^,^,^i^H^^,^,^,ltt*******************************l^******’tl*********** 

need  to  compute  the  DESIRED  QUANTITY  ******************* 
Q**%it<*i4ciiiiit4i4<4<:t‘4"t>  OPTIONS  1,  4  &  S:  BURN  RATE  *******'*'***i'*Ki")“i'f»‘Kt"t‘*4'** 
Q4r**iti«i**iiiit>«4>*4i*  OPTION  3:  SURFACE  AREA 

^  4i  **  Id  Hi  4>  *  4>  4i  ******  <1 4i«*i|i4r  4<  *  It<  *  Ik  *  4>  «>  4>  ***  4>  *  4>  4>  ******  III  *  If' %  III  III  *  ||<  Ik  I|>  «> 


IF  (ICTYP  .EQ.  3)  THEN 
CALL  BURNRT  (PCH  (N).  LYR  (N).  RBR  (N)) 
ASUR  (N)  =  -  (DMSDTN/(RHOS  (N)*RBR  (N))) 
ELSE 

RBR  (N)  =  -  (DMSDTN/(RHOS  (N)*ASUR  (N))) 
END  IF 
C 

CALL  OUTPUT  (N) 

C 

1120  CONTINUE 
C 


RETURN 

END 


^  Hi  4i  k  Ik  k  *  *  Ik  4i  k  *  k  k  *  k  *  k  *  *  k  k  k  4i  k  k  Ik  k  Ik  *  *  Ik  *  *  III  *  *  Ik  k  k  Ik  Ik  k  *  Hi  k  k  *  4i  k  4i  *  k  *  *  k  Hi  k  k  *  *  k  Ik  Ik  k  k  *  k  Ik  *  *  k 

Qkkkkk 


SUBROUTINE  SHEVAL  (JL,  NTO) 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

E|kkkkk 


C**  NOTATION:  JL  =  LOCAL  "J"  LAYER  TO  BE  EXCLUDED  FROM  SUMS 

Qkkkkk 

C**  NTO  =  TOTAL  NUMBER  OF  PROPELLANT  LAYERS 

^kkkkk 


C**  (output)  SH1.SH2.SH3,SH4  returned  in  COMMON/SUMS 

Qkkkkk 


Qkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkk 

COMMON  /SUMS/  SHI,  SH2,  SH3.  SH4 
COMMON  /SOLIDL/  SMSOL  (15).  XI  (15) 

COMMON  /AVEPROP/  RHOSAV  (15).  SESOAV  (15).  SBCGAV  (15).  RGCGAV  (15), 
1  CVCGAV  (15) 

^k4ikkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkk 

(^kkkkkkk  Form  Sums  Which  Remain  Constant  in  Layer  "JL" 

C 

SUMI  =  0.0 
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DO  1000  I  =  1.  NTO 

SUMI  =  SUMI  +  SMSOL  (I)*(XI  a)/RHOSAV  (I)  +  SBCGAV  (I)*(1.0  -  XI  (I))) 
1000  CONTINUE 
C 

SHI  =  SUMI  -  SMSOL  (JL)*(XI  (JL)/RHOSAV  (JL)  +  SBCGAV  (JL)*(1.0  -  XI  (JL))) 
C 

c 

SUMI  =  0.0 
DO  1010  I  =  1,  NTO 

SUMI  =  SUMI  +  SMSOL  (I)*RGCGAV  a)*(1.0  -  XI  (I)) 

1010  CONTINUE 
C 

SH2  =  SUMI  -  SMSOL  (JL)*RGCGAV  (JL)*(1.0  -  XI  (JL)) 

C 

Q^rnti**** 


C 

SUMI  =  0.0 
DO  10201  =  1.  NTO 

SUMI  =  SUMI  +  SMSOL  (I)*CVCGAV  (I)*(1.0  -  XI  (I)) 
1020  CONTINUE 
C 

SH3  =  SUMI  -  SMSOL  (JL)*CVCGAV  (JL)*(1.0  -  XI  (JL)) 
C 

c 

SUMI  =  0.0 
DO  1030  I  =  1,  NTO 

SUMI  =  SUMI  +  SMSOL  (I)*XI  (I)*SESOAV  (I) 

1030  CONTINUE 
C 

SH4  =  SUMI  -  SMSOL  (JL)*XI  (JL)*SESOAV  (JL) 

C 


^*4t4i4>4r 


RETURN 

END 


SUBROUTINE  PTCALC  (J.  XIK,  PCHK,  TCHK,  QWK) 

C***  Subroutine  "PTCALC"  calculates  PCH  and  TCH  for  Layer  "J"  given  the 
C 
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C***  "Kth"  iteraUve  value  of  the  mass  fraction  "XI"  ;IXI=SMS/SMSO] 

Q 

^  *  III  *  *  4i  *  *  «  *  A*  «  «  « iti «  w  He  III  itiiti  4<  1)1 *  41  *  4<  4i  4i  *  *  4<  %  it<  itn|t «  *  !|>  i|c  41 1|<  A  «  *  4i>|<  *  >«> «  *  4<  *  >l>  >t>  *  4^  <)■  >••  *  *  *  4>  * 


^4i4i4i4i4i 

COMMON  /ARRAYS/  A3  (100),  PX  (11,  15.  5) 

COMMON  /ETC/  EE  (1000) 

C 

COMMON  /FIXED/  CHI,  CH2.  CH3.  CAPEO,  QWMAX,  PCHAMX 
COMMON  /SUMS/  SHI,  SH2,  SH3.  SH4 


COMMON  /NVALUE/  RHOSRN,  ASURN,  DPTHBN,  TPMRGM 
COMMON  /SOLIDIV  SMSOL  (15),  XI  (15) 

COMMON  /SCALE/  RHOSTR.  TRS'FR,  PRSTR,  RBRSTR,  VOLSTR,  SURSTR,  ELSTR 
1  .  SMSSCL,  CVRSCL.  SERSCL,  TIMSCL 
COMMON  /METH/  IMOD 


^  4i  41 4i  4i  4<  4i  4i  4i  4i  *  4i  41 4i  4i  1^  4i  4i  4i  4i  4i  41 4i  4i  4i  41 4i  41 4i  41 4i  41 41 41 41 41 4i  41 4i  4i  4i  41 4i  4i  41 41 41 4i  4i  4i  41 41 41 41 4i  41 41 41 41 4i  4i  4i  4i  41 4i  4i  41 4i  41 4i  4i 


^4■l|l4l4l4■ 

C**  Compute  the  latest  value  of  Total  Propellant  Mass  Remaining  in  Chamb 
Cer  ** 


^  4i  4i  4i  41 4i  41 41 4i  41 4i  *  41 41 41 41 4i  41 41 4i  41 4i  4i  4i  4i  4i  41 4i  4i  41 4i  4i  4i  41 4i  4i  4i  41 4i  41 41 4i  41 4i  4i  41 41 4>  41 41 41 41 41 41 41 41 4i  41 4i  41 41 41 4<  41 41 4i  4>  41 4i  41 41 41 
Q4i4i4i4i4i 

c 


NTL  =  INT  (A3  (4)  +  0.5) 
JPl  =  J  +  1 
C 

SUMI  =  0.0 


IF  (JPl  .LE.  NTL)  THEN 
DO  1000  I  =  JPl.  NTL 
SUMI  =  SUMI  +  SMSOL  (I) 
1000  CONTINUE 
END  IF 


C 

TPMRGM  =  (SUMI  +  XIK*SMSOL  (J))*SMSSCL 
C 

^  4i  41  m  4i  Hi  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  41 41 4i  4i  4i  4i  41 41 41 41 41 4i  41 4  4i  41 4i  41 4i  4i  41 41 4i  41 4i  4i  4i  *  4i  41 4i  41 41 4i  Hi  41 4i  41 4i  41 4i  4i  41 4<  4i  41 41 41 41 41 41 4i  41 41 4i 

C**  Call  "DEPTH-BURNED"  Subroutine  to  get  Surface  area  +  all  integrals 

^  Hi  41 4i  41 4i  4i  4i  41 4i  4i  Hi  4i  4i  41 41 41 4i  4i  41 4i  m  41 4i  Hi  41 4i  4i  41 4i  4i  4i  4i  4i  Hi  41 4i  4i  4i  41 4i  41 4i  4i  4i  4i  4i  4i  41 4i  4i  Hi  41 41 4i  41 4i  41 4i  41 4i  4i  4i  4  41 4i  4  4i  4i  4i  4i 

c 

CALL  DEPTH  (TPMRGM,  J,  1.  DEPTHCM,  ASURCM2) 

C 

^44444444444444444444444444444444444444444444444444444444<;i4444444444444 

DPTHBN  =  DEPTHCM/ELSTR 
ASURN  =  ASURCM2/SURSTR 
C 

VOLRM  =  PX  (8.  J.  3)  -  PX  (8,  J,  5) 

RATV  =  PX  (8.  J.  5),1>X  (8.  J.  3) 

C 

IF  (RATV  .LT.  0.02)  THEN 
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SBCGN  =  PX  (6,  J.  1)*RH0STR 
RGCGN  =  PX  (9,  J.  1)/CVRSCL 
CVCGN  =  PX  (10,  J,  1)/CVRSCL 

RHOSRN  =  ((PX  (4,  J.  3)  -  PX  (4,  J.  5))A'OLRM)/RHOSTR 
SESRN  =  ((PX  (11.  J.  3)  -  PX  (11.  J.  5))A^OLRM)/SERSCL 
ELSE  IF  (RATV  .GT.  0.98)  THEN 
SBCGN  =  (PX  (6,  J.  5)/PX  (8.  J.  5))*RHOSTR 
RGCGN  =  (PX  (9.  J.  5)/PX  (8.  J,  5))/CVRSCL 
CVCGN  =  (PX  (10.  J.  5)/PX  (8.  J.  5))/CVRSCL 
RHOSRN  =  PX  (4.  J.  2)/RHOSTR 
SESRN  =  PX  (11,  J.  2)/SERSCL 
ELSE 

SBCGN  =  (PX  (6,  J,  5)/PX  (8,  J,  5))*RHOSTR 
RGCGN  =  (PX  (9,  J,  5)/PX  (8.  J,  5))/CVRSCL 
CVCGN  =  (PX  (10.  J.  5)/PX  (8.  J.  5))/CVRSCL 
RHOSRN  =  ((PX  (4.  J.  3)  -  PX  (4.  J.  5))A'OLRM)/RHOSTR 
SESRN  =  ((PX  (11.  J.  3)  -  PX  (11.  J.  5))A'OLRM)/SERSCL 
END  IF 
C 

AMSESO  =  SMSOL  (J)*SESRN 
ATvICVCG  =  SMSOL  (J)*CVCGN 
AMSBCG  =  SMSOL  (J)*SBCGN 
AMRGCG  =  SMSOL  (J)*RGCGN 
AMRHOS  =  SMSOL  (J)/RHOSRN 
C 

C***  Iterate  3  Umes  for  "PCHK"  and  "TCHK" 

C 

DO  1010  KI  =  1.3 
C 

C***  Compute  Current  Value  of  Cumulative  Heat  Loss  "QWK" 

C 

CALL  QWCOMP  (QWK.  PCHK) 

C 

TOP  =  CAPEO  -  QWK  -  SH4  -  AMSESO*XIK 
BTM  =  CH3  +  SH3  +  AMCVCG*(1.0  -  XIK) 

TCHK  =  TOP/BTM 
C 

TOP  =  TCHK*('^H2  +  SH2  +  AMRGCG*(1.0  -  XIK)) 

BTM  =  CHI  -  SHI  -  AMSBOG*(l  0  -  XIK)  -  AMRHOS*XIK 
PCHK  =  TOP/BTM 
C 

1010  CONTIT'IUE 
C 

RETURN 

END 
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SUBROUTINE  QWCOMP  (QWO,  PCHNO) 

*  4>  4<  *  *  <1  *  *  4<  *  4<  *  4<  *  Ik  « I!  *  *  >)•  4<  ■t' *  «  *  *  4i  *  4>  Ik  *  *  *  «> «  *  «  *  4<  *  *  4^ «  4>  4>  it<  itc  i|<  ■)>  it<  it<  4<  *  >*<  *  « >•<  4^  »<  4<  4>  i|<  %  it>  1)^  4>  *  *  « 
^ik4<4<4<4> 

COMMON  /nXED/  CHI,  CH2.  CH3.  CAPEO,  QWMAX,  PCHAMX 
C 

QWO  =  QWMAX*(PCHNO/PCHAMX) 

C 

^  Ik  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4<  4i  4i  4t  4i  4i  4i  4i  4i  4i  4<  4i  4i  4<  4i  4i  4<  4<  4i  4>  4i  4>  4i  4i  4i  *  4<  4i  4i  4>  4<  4i 
^ikik4iikik 

RETURN 

END 

Q  4c  4i  4i  4i  4i  4<  4i  Ik  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4>  4<  4<  4i  4>  4>  4i  4i  4i  4  4>  4i  4i  4i  4i  4>  4>  4i  4i  4i  4i  41 4i  4i  4i  4i  4i  4<  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i 
^Ik4i4i4i4> 

c 


SUBROUTINE  BURNRT  (PG,  JL,  RBRJ) 

C 

C  PG:  SCALED  (ND)  PRESSURE 
C  JL:  LAYER  BURNING 
C  RBRJ:  SCALED  (ND)  BURN  RATE 

^ik  4i  4i  4i  Ik  Ik  4i  Ik  4i  4>  Ik  4i  4i  4  4>  4i  4i  4i  Ik  4i  Ik  4c  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4<  4<  4>  4i  4i  Ik  4i  Ik  4i  4c  4<  4i  Ik  4c  4  Ik  4<  Ik  4i  Ik  4i  4<  4c  4c  4i  4i  4c  4i  4<  4i  4i  4  4i 
^44444 


COMMON  /ARRAYS/  A3  (100),  PX  (11,  15.  5) 

COMMON  /CONTRL/  NTL,  CHVOL.  HLFRAC,  DT,  NMAX,  CONVRG,  ICTYP 
COMMON  /SCALE/  RHOSTR,  TRSTR,  PRSTR,  RBRSTR,  VOLSTR,  SURSTR,  ELSTP 
1  ,  SMSSCL,  CVRSCL.  SERSCL,  TIMSCL 

COMMON  /AVEPROP/  RHOSAV  (15).  SESOAV  (15),  SBCGAV  (15),  RGCGAV  (15), 

1  CVCGAV  (15) 


^44444444444444444444444444444444444444444444444444444444444444444444444 


^4444444444444  ACTUAL  PRESSURE  IS  PGMPA  44444444444444444444444444444444 


^44444444444444444444444444444444444444444444444444444444444444444444444 


PGMPA  =  PG*PRSTR 

^44444444444444444444444444444444444444444444444444444444444444444444444 

C  GENERAL  ROUTINE  TO  HND  BURN  RATE.  BASED  UPON  PRESSURE  NOT  THE  LAYER 

^44444444444444444444444444444444444444444444444444444444444444444444444 


IF  (A3  (5)  .GT.  0.0)  THEN 
NNUM  =  A3  (5) 

LAST  =  NNUM  +  49 

^44444444444444444444444444444444444444444444444444444444444444444444444 


(^44444444444444  CURRENT  PRESSURE  ABOVE  ALL  PRESSURE  ENTRIES  »**••**♦*•*• 

(<44444444444444444444444444444444444444444444444444444444444444444444444 

IF  (PGMPA  .GT.  A3  (LAST))  THEN 
XYl  =  ALOGIO  (A3  (LAST  +  30)) 

XY2  =  ALOGIO  (A3  aAST  +  29)) 

XY3  =  ALOGIO  (A3  aAST)) 

XY4  =  ALOGIO  (A3  aAST  -  1)) 

XY5  =  ALOGIO  (PGMPA) 

RBRJ  =  (XYl  ■  XY2)/(XY3  -  XY4)*(XY5  -  XY3)  +  XYl 
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RBRJ  =  10.**RBRJ 
RBRJ  =  RBRJ/RBRSTR 
RETURN 
END  IF 

^  *  41 « i)i  *  *  III «  *  *  *  4>  *  «  4ii|i  *41 4i «  4i  41  Ill  !)■  4ii|i «  «  4i  *  ifil,  itciti  ■!<  i«< « i|c  4^  >l<  *  4>  *  *  ><<  >•<  >*•  >*>  >*>  >•■  *  >•<  il>  4> 


(^4i4i4<4'4i4<4<4i4i4i4<*4i  CURRENT  PRESSURE  BELOW  ALL  ENTRIES  *********************■•. 


^  Hi  4c  4i  41 4i  4i  4<  4  4<  *  4I  *  4<  41 4i  41  *  41 4i  4i  4i  41 4i  41 4i  4i  41  m  4i  4i  4<  4  m  41  m  *  4  4i  *  4i  4i «  41 4  41 4i  Hi  4>  4  4  41 4i  4  4i «  Hi  4i  4  41  III  41 41  m  41 4  41 41 41 4i  41 41 


IF  (PGMPA  .EQ.  A3  (50))  THEN 
RBRJ  =  A3  (80) 

RBRJ  =  RBRJ/RBRSTR 
RETURN 
END  IF 

IF  (PGMPA  .LT.  A3  (50))  THEN 
XYl  =  ALOGIO  (A3  (81)) 

XY2  =  ALOGIO  (A3  (80)) 

XY3  =  ALOGIO  (A3  (51)) 

XY4  =  ALOGIO  (A3  (50)) 

XY5  =  ALOGIO  (PGMPA) 

RBRJ  =  (XYl  -  XY2)/(XY3  -  XY4)*(XY5  -  XY4)  +  XY2 
RBRJ  =  10  **RBRJ 
RBRJ  =  RBRJ/RBRSTR 
RETURN 
END  IF 


^44444444444444444444444444444444444444444444444444444444444444444444444 


^44444444444444  pressure  in  MIDDLE  4444444444444444444444444444444444444 
^44444444444444444444444444444444444444444444444444444444444444444444444 


DO  1000  JJ=  l.NNUM 
JJJ  =  JJ  +  49 

IF  (PGMPA  .LE.  A3  (JJJ))  THEN 
JJJJ  =  JJ  +  79 
XY5  =  ALOGIO  (PGMPA) 

XYl  =  ALOGIO  (A3  (JJJ  -  1)) 

XY2  =  ALOGIO  (A3  (JJJ)) 

XY3  =  ALOGIO  (A3  (JJJJ)) 

XY4  =  ALOGIO  (A3  (JJJJ  -  1)) 

RBRJ  =  (XY5  -  XY1)/(XY2  -  XY1)*(XY3  -  XY4)  +  XY4 
RBRJ  =  10  **RBRJ 
RBRJ  =  RBRJ/RBRSTR 
RETUPJ^ 

END  IF 

1000  CONTINUE 
END  IF 

^44444444444444444444444444444444444444444444444444444444444444444444444 
C***********  NEXT  THE  ROUTINE  IS  BASED  UPON  THE  LAYER  444444444444444444 
^44444444444444444444444444444444444444444*44444444444444444444444444444 


IF  (A3  (5)  .LT.  0.0)  THEN 
NNUM  =  ABS  (A3  (5)) 
INDEX  »  50  +  2*(JL  -  1) 
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RBRJ  =  (A3  (INDEX)/RBRSTR)*PGMPA**A3  (INDEX  +  1) 
END  IF 
RETURN 
END 


^  *  *  *  *  *  *  *  *  *  *  «  *  *  *  *  *  *  *  *  4^  Hi  It<  4' >t>  *  *  %  >l<  %  >*>  >•<  *  I|<  Ik  *  *  *  IK  *  4>  >•<  4<  *  4>  4< 


^ik**** 

c 


SUBROUTINE  SETVAL 


^  Ik  « Ik  Ik  k  4i  *  *  >k  >k  4i  4i  4i  %  *  k  %  *  *  Ik  «  *  *  *  4<  *  *  «  <1 4>  k  4<  Ik  Ik  *  4i  4<  *  *  «  *  4i  4i  *  4i  4<  4i  4i  *  k  4i  k  Ik  4i  Ik  k  k  Ik  k  Ik  Ik  k  4<  k  Ik  4i  4i  *  4i  4>  k 


^kkikk* 


COMMON  /ARRAYS/  A3  (100),  PX  (11.  15.  5) 

COMMON  /ETC/  EE  (1000) 

COMMON  /CONTRL/  NTL.  CHVOL.  HLFRAC,  DT,  NMAX,  CONVRG,  ICTYP 
COMMON  /SCALE/  RHOSTR.  TRSTR.  PRSTR,  RBRSTR.  VOLSTR,  SURSTR,  ELSTR 


1  ,  SMSSCL,  CVRSCL.  SERSCL.  TIMSCL 
COMMON  /SOLIDIV  SMSOL  (15).  XI  (15) 

COMMON  /IGNITOR/  SMSIG.  SESIG.  RHOSIG.  WTMIG.  SBIG,  RGIG,  CVIG 
COMMON  /AIR/  SMSA,  WTMA.  SBA.  RGA.  CVA 


^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


^kkkkk 

C**  Set  Total  Number  of  Propellant  Layers  (NTL).  Chamber  Volume  (CHVOLS) 
C; 

C**  Time  Step  (DTS  IN  MSEQ,  Maximum  Number  of  Time  Steps  (NMAX), 
C**  and  Convergence  Tolerance  (CONVRG) 

C 

NTL  =  INT  (A3  (4)  +  .5) 

CHVOLS  =  A3  (23) 

DTS  =  A3  (42) 

NMAX  =  1200 

ICTYP  =  INT  (A3  (2)  +  .5) 

HLFRAC  =  0.0 
C 

C**  Scale  Chamber  Volume  (CHVOL) 

C 

CHVOL  =  CHVOLS/VOLSTR 
C 

C**  Scale  Time  Step  (DT) 

C 

DT  =  DTS/TIMSCL 
C 

C**  Set  ND-Valucs  of  Propellant  Mass  (SMSOL) 

C 

DO  10001  «  l.NTI. 

SMSOL  (1)  =  PX  (4, 1,  3)*A3  (46)/SMSSCL 
1000  CONTINUE 
C 

SMSIG  =  A3  (26)/SMSSCL 
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^  *  4> «  *  *  4i  *  <1  *  «  *  III  *  *  *  *  *  i|>  4>  *  4i  *  li  *  41 4<  *<•>  *  «>  *  ixlc  *  *  III «  «  *  *  *  it<  *  4>  *  *  >•■  >t<  >t<  >t< « >*■  it>  >*•  *  *  4<  *  Ik  *  #  <*•  <*•  <*■  4' >t<  4> 

Q^^^**:tt*^*^l^i^t^t*m*******  MASS  IS  DETERMINED  ************************* 

^  Ik  4<  *  *  Ik  *  Ik  *  <1  *  «  *  *  «  *  Ik  *  *  *  *  *  **  *  « Ik  Ik  Ik  *  4i  4|  4> «  4>  Ik  Ik  Ik  4>  «>  Ik  Ik  *  *  *  Ik  *  k  *  *  Ik  Ik  Ik  Ik  Ik  4c  Ik  k  Ik  Ik  Ik  Ik  *  *  «  4|  4i  *  *  *  Ik 


SUM  =  0.0 
DO  1010  I  =  l.NTL 
SUM  =  SUM  +  PX  (8. 1.  3) 

1010  CONTINUE 

SUM  =  SUM* A3  (46) 

SUM  =  SUM  +  A3  (26)/A3  (15) 

SUM  =  CHVOLS  -  SUM 
SMSA  =  SUM*.001204 
CALL  CLEAR 
WRITE  (*.  6000)  SMSA 

6000  FORMAT(///,10X,’The  computed  mass  of  air  in  the  bomb  is:’,F10.5, 

1/,10X, 'grams.  Do  you  wish  to  change  this  value  to  0.0  gm?’, 

2/,10X.’(Yes  =  1  /  No  =  2)’y/.10X.’Enter  your  choice.’^/) 

READ  (*.  *)  lAIR 
IF  (lAIR  .EQ.  1)  THEN 
SMSA  =  0.0 
ELSE 

SMSA  =  SMSA/SMSSCL 
END  IF 
C 

C**  Set  all  values  for IG"  (ignitor)  and  "—A"  (air) 

C 

WTMIG  =  A3  (16) 

WTMA  -  28.9 
GAMMAA  =  1.4 
C 

SBIG  =  A3  (17)*RHOSTR 
SBA  .98*RHOSTR 
RGIG  =  (1.98717/A3  (16))/CVRSCL 
RGA  *  (1.98717/WTMA)/CVRSCL 
CVIG  =  RG1G/(A3  (18)  -  1.0) 

CVA  =  RGA/(GAMMAA  -  1.0) 

C 

SESIG  =  (A3  (14)/TRSTR)*CV1G 
RHOSIG  =  A3  (15)/RH0STR 
C 

^4i4i4i4i4i*4i**4i4i4i<i4i***«4i*****ik*4i*ik***4i4iik4i4i4iik4i4i4i*4i*4i4i4i4i*4i4i4i4i4i4i*4i4i4i4iik4iik4iik4i4i4i4i4i 

c*** 

C*******  WRITE  TABULATION  OF  INPUT  DATA  TO  UNIT  (1 1)  ****•****••*•*•*• 
C*** 

c*** 

c 


WRITE  (11.  6010) 
WRITE  (11.  6020) 


305 


WRITE  (11,6020) 

C 

CnVOLP  =  CHVOL*VOLSTR 
DTP  =  DT*TIMSCL 
C 

WRITE  (11,  6030)  NTL,  CHVOLP,  HLFRAC,  DTP,  NMAX,  CONVRG,  ICTYP 
WRITE  (11,  6020) 

WRITE  (11,6040) 

WRITE  (11,6020) 

WRITE  (11,6050) 

WRITE  (11,6020) 

C 

DO  10201  =  1,NTL 

WRITE  (11,  6060)  I,  SMSOL  (I)*SMSSCL 
1020  CONTINUE 

SMSIGP  =  SMSIG*SMSSCL 
SMSAP  =  SMSA*SMSSCL 
WRITE  (1 1,  6070)  SMSIGP 
WRITE  (11,  6080)  SMSAP 
C*** 

WRITE  (11,  6020) 

WRITE  (11,  6090) 

WRITE  (11,6020) 

C*** 

DO  10301  =  1,NTL 

WRITE  (11,  6060)  I,  PX  (4,  1,  1),  PX  (4, 1,  2) 

1030  CONTINUE 

WRITE  (11,  6070)  A3  (15) 

C*** 

WRITE  (11,  6020) 

WRITE  (11,  6100) 

WRITE  (11,  6020) 

C*** 

DO  10401  =  1,N1U 

WRITE  (11,  6060)  1,  PX  (2,  I,  1),  PX  (2, 1,  2) 

1040  CONTINUE 

WRITE  (11,  6070)  A3  (13) 

C*** 

WRITE  (11,6020) 

WRITE  (11,  6110) 

WRITE  (11,  6020) 

C*** 

DO  10501  =  1,NTL 

WRITE  (11,  6060)  I,  PX  (3,  1,  1),  PX  (3, 1.  2) 

1050  CONTINUE 

WRITE  (11,  6070)  A3  (14) 

C*** 

WRITE  (11,  6020) 
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WRITE  (51.  6120) 

WRITE  (11.  6020) 

C*** 

DO  1060  I  =  l.NTL 

WRITE  (11.  6060)  I.  PX  (5. 1.  1).  PX  (5. 1.  2) 
1060  CONTINUE 

WRITE  (11.  6070)  A3  (16) 

WRITE  (11.  6080)  WTM A 

C*** 

WRITE  (11.  6020) 

WRITE  (11.  6130) 

WRrrE(ll.  6020) 
c*** 

DO  10701  =  l.NTL 

WRITE  (11.  6060)  I.  PX  (9. 1.  1).  PX  (9.  I.  2) 
1070  CONTINUE 

RGIGP  =  RGIG*CVRSCL 
WRITE  (11.  6070)  RGIGP 
RGAP  =  RGA*CVRS(X 
V/RITE(11.6080)RGAP 
C*** 

WRITE  (11.  6020) 

WRITE  (11.  6140) 

WRITE  (11.  6020) 

C*** 

DO  1080  I  =  1.  NTL 

WRITE  (11.  6060)  I.  PX  (7. 1.  1).  PX  (7. 1.  2) 
1080  CONTINUE 

WRITE  (11.  6070)  A3  (18) 

WRITE  (11.  6080)  GAMMAA 

C*** 

WRITE  (11.  6020) 

WRITE  (11.  6150) 

WRITE  (11.  6020) 

C*** 

DO  10901  =  l.NTL 

WRITE  (11.  6060)  I.  PX  (10. 1.  1).  PX  (10.  I.  2) 
1090  CONTINUE 

CVIGP  =  CVIG*CVRSCL 
WRITE  (11.  6070)  CVIGP 
CVAP  =  CVA*CVRSCL 
WRITE  (11.  6080)  CVAP 
C*** 

WRITE  (11.6020) 

WRITE  (11.  6160) 

WRITE  (11.  6020) 

C*** 

DO  11001  =  l.NTL 
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WRITE  (11.  6060)  I.  PX  (6.  I.  1).  PX  (6. 1,  2) 
1100  CONTINUE 

WRITE  (11,  6070)  A3  (17) 

SBAP  =  SBA/RHOSTR 
WRITE  (11,  6080)  SBAP 
C*** 


WRITE  (11,  6020) 
WRITE  (11,  6020) 


Q  «t  *  «  *  *  <1  *  4<  i|i  4i  4. «  *  4i  *  4.1)1 4iit<  4<  4i  4i  4i  4i  41  *  %  «  4r  4i  *  *  *  *  «  *  4i  4t  4i  #  4, «  *  4.  Hiili *  4. 4. 4. 


RETURN 

^  4. 4>  4<  4. 4>  *  4. 4<  4. 4. 4. 4. 4>  4. 4i  4. 4. 4. 4.  *  4>  4<  4. 4>  4>  4>  4. 4  4>  4  4. 4>  4<  4<  4. 4>  4  4. 4>  4. 4. 4. 4. 4. 4. 4. 4>  4. 4  4>  4  4  4. 4  4<  4>  .f  4>  4<  4i  4>  4. 4. 4. 4> 
Q44444444444444444444444  pQRMAT  STATEMENTS  44444444444444444444444 
^4444444444444444444444444444444444444^444444444444444444444444444 


6010  FORMAT(//) 

6020  FORMATC  *****'*'***«*'*'**4'4'4'*4'*********'*4'<'4'4'<"t'*"t"l"*'<"^4"^*4'<'*‘44>^ 

J  •444444444444444444444444444444444444*^ 

6030  FORMAT(5X,*Total  #  Layers  =  \\AJ, 

1  5X,’Chamber  Volume  (cm3)  =’,F10.3y. 

2  SX,’Heat'Loss-Fraction  (n-d)  =’J^10.3,/, 

3  5X,Time  Step  (mil-sec)  =‘,E16.8,5X,’Max  Time  Steps  =  ',V1J 

4  SX, ’Convergence  Criterion  =  ’£16.8y 

5  SX.’ComputaUon  Type  (1=BURN-RATE.  2=PTGEN,  3=SURF  AREA,  4=INTERR 

6  BOMB,  5=ETC)’.I5) 

6040  FORMAT(20X.’Beginning(l)  of  Layer’,10X,’End(2)  of  Layer’) 

6050  FORMAT(l OX, ’Propellant  Mass  in  grams’) 

6090  FORMAT(l OX, ’Propellant  Density  in  g/cc’) 

6110  FORMAT(l OX, ’Propellant  Hame  Temperature  in  deg  K’) 

6120  FORMAT(10X, ’Propellant  Molecular  Weight  in  g/g-molc’) 

6130  FORMAT(10X, ’Propellant  Gas  Constant  in  cal/g-deg  K’) 

6140  FORMAT(10X, ’Gamma  (Ratio  of  Specific  Heats)’) 

C 

6060FORMAT(5X,I5,10X,F15.5.10X.F15.5) 

6070  FORMAT(6X,’Ignitor’,7XJ=15.5) 

6080  FORMAT(8X,’Air’.9X,F15.5) 

C 


6150  FORMATdOX.’Spccific  Heat  (Cv)  in  cal/g-dcg  K’) 

6160  FORMATdOX.’Covolume  in  cm3/g’) 

6100  FORMAT(10X, 'Propellant  Impetus  in  J/g’) 

(^44444444444444444444444444444444444444444444444444444 

END 

(^44444444444444444444444444444444444444444444444444444444444444444444444 

c***** 

SUBROUTINE  OUTPUT  (NT) 

. . 4444 

C44444 

COMMON  /ARRAYS/  A3  (100),  PX  (1 1.  15,  5) 

COMMON  /CONTRIV  NTL,  CHVOL,  HLFRAC,  DT.  NMAX,  CONVRG,  ICTYP 
COMMON  /SOLUT/  TIME  (1000),  PCH  (1000),  RBR 
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1  (1000),  TPMR  (1000).  SMS  (1000) 

2  .  RHOS  (1000),  TCH  (1000),  DPTHB  (1000). 

3  ASUR  (1000),  LYR  (1000) 

COMMON  /SCALE/  RHOSTR.  TRSTR.  PRSTR.  RBRSTR.  VOLSTR.  SURSTR.  ELSTR 
1  .  SMSSCL.  CVRSCL.  SERSCL.  TIMSCL 


TIMP  =  TIME  (NT)*nMSCL 
PCHP  =  PCH  (NT)*PRSTR 
TCHP  =  TCH  (NT)*TRSTR 
TPMRP  =  TPMR  (NT)*SMSSCL 
RBRP  =  RBR  (NT)*RBRSTR 
ASURP  =  ASUR  (NT)*SURSTR 
DEPTHP  «  DPTHB  (NT)*ELSTR 
A3  (100)  =  NT 


WRITE  (1 1.  6000)  NT.  LYR  (NT).  TIMP.  PCHP.  TPMRP.  RBRP 
1  .  ASURP.  TCHP.  DEPTHP 
6000  FORMAT(lX.*N=M5.’  LAYER=M2.7E16.8) 

C 

RETURN 

END 


(^****«***»**«*«.»*****4.*«  SUBROUTINE  CLEAR  *******•••«■*****•****•****•••• 

. . . 

SUBROUTINE  CLEAR 
CHARACTER  STM 
DATA  ST/’  (2J’/ 

WRITE  (*.  6000)  ST 
6000  FORMAT  (1X.A4) 

RETURN 

END 

. . . . . . . 

SUBROUTINE  DEPTH  (XMAS.  J.  IFLAG.  DB.  SA) 

. . 

C  Version:  3.0.  January  1992 

C  Written  by:  William  Oberte.  U.S.  Anny  Research  Laboratory 
C  This  program  will  determine  the  depth  burned  on  a  grain  and 
C  compute  the  necessary  integrals  for  the  compuution. 

C 

C  XMAS:  total  mass  of  all  grains  remaining  in  the  chamber  in  grams 
C  IFLAG:  flag  for  desired  information;  I  •  compute  integrals  &  Surf  A 
C  2  -  compute  surf  Area  only 

C  J:  layer  burning 
C  DB:  depth  burnt  in  cm 

C  SA:  loud  burning  surface  area  (all  grains)  in  cm^2 

. . . . * 
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COMMON  /ARRAYS/  A3  (100),  PX  (11,  15.  5) 

COMMON  /CONTRL/  NTL,  CHVOL,  HLFRAC,  DT,  NMAX,  CONVRG,  ICTYP 
COMMON  /METH/  IMOD 
PARAMETER  (PI  =  3.141593) 


^  *  *  *  *  *  *  *  *  «  *  41 4,  **11, 4i  4, 4i  4, 4ii|i  4r  4i  4i «  4, 4i  4i  4i <1  *  «  4,  *  It  4,  *  4, 4, 4, 4, 4i  4iiti  4,  4>  41 <)<  Hi  >*<  *  4<  *  *  * 

0********************  TEST  for  negative  MASS  4,4,************************* 
^*************************************************,,.1********************* 


IF  (XMAS  .LE.  0.0)  THEN 
DB  =  A3  (I) 


SA  =  0.0 
RETURN 
END  IF 

^********************************«i*********4i**************************** 

C*********  DETERMINE  MASS  PER  GRAIN  &  GRAIN  TYPE  *********************** 
^*********************************************************************** 


XMASG  =  XMAS/A3  (46) 
ITYPE  =  INT  (A3  (45)  +  .5) 


^*********************************************************************** 
(3************  ,3RS  ^  1  means  use  constant  values  otherwise  ************* 
C************  ISRS  =  2  means  use  CONSTANT  VALUES  FOR  LAYERS  ************ 
C************  WILL  USE  INTEGRALS  TO  PRODUCE  THERMO  PROPERTIES  ********** 

^4i4i*4>4i4<4,4>4>*4>************4>**4>4>****4i4<4>4>4,4<4>4>4<4>4,4>***«4>4i4i4>4>4>4>4i4i4>4>4>*4,4>4>4>**4>*4i,4 


ISRS  =  INT  (A3  (31)  +  .5) 

^4>4>4,*4,4>***4>4>4i**4>********«********4>*4>4>4i«4>*4>4>4,4>4>**,44i4>*4'******************* 

C************  DETERMINE  MASS  BURNED  IN  LAYER  (ONE  GRAIN)  *************** 

^4>**************************4>*****4i*4i*4i***4>4i*4>4i**************4>  4,4,4, 4,4i***4,* 


NL  =  INT  (A3  (4)  +  .5) 

SUM  =  0.0 
DO  10001  =  J,NL 
SUM  =  SUM  +  PX  (4. 1,  3) 

1000  CONTINUE 

XMB  =  SUM  •  XMASG 

0****4,4,*********4>*4,*4,4,4,******4>*4i**««****4>**4>4,4,*4,4,4>4,*4,*4,*4,*4,*4,«*«,»*4'4,«*4, 

(^********«,******«  CHECK  IF  ON  BOUNDARY  OF  LAYER  *********************** 


IF  (ABS  (XMB/PX  (4.  J.  3))  .LE.  l.OE-3)  THEN 
DB  =  PX(1,J,  1) 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB,  DB) 
SA  =  SFAREA* A3  (46) 

PX  (4,  J.  5)  =  0.0 
PX(I,J.  5)  =  PX(1,  J.  I) 

PX  (6,  J,  5)  =  0.0 
PX  (8.  J.  5)  =  0.0 
PX  (9,  J.  5)  =  0.0 
PX  (10.  J.  5)  =  0.0 
PX(11.  J.  5)  =  0.0 
RETURN 
END  IF 
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Q  Itciti  4<  <I  »<  *  *  4ci|i  4i  4<  4<  %  4>  *  <|i4i  *>  4i  %  4<  %  It<  It<  4i  *  41 4>  *  4>  411*1  III  I|>  It>  4<  i(<  Ilcif  4cit> « ■!<  4i  Itc  4i  3)1 4<  *  4<  I|<  It>  4<  *  4>  !*■  >*■  *  4<  4<  *  Ilcik  4<  4>  4: 

q4>4.4<4<4>4<*4<4<4>4>4<4>4i4<4>4>*4<  FIRST  IF  THE  PROPERTIES  ARE  CONSTANT  ************** 
^4<4i4>4c4>434i4<4>4>4<4c4<4>4<4<4i4i43  AND  WE  HAVE  A  SINGLE  GRAIN  ********4<4>4<*4c4<4i434i4i4i434>4i4>4< 
^  4> »  4t  14  4>  4<  4<  4<  4>  4>  4>  4c  4<  4<  4<  43  4^  4<  4>  4<  4>  4<  4i  4<  4<  4c  4i  4i  4' 4<  4>  43  4>  4' 43  4<  4i  4<  4<  4i  4<  43  43  4<  *  4<  43  4<  4<  4i  4>  4c  4i  4i  4<  4i  4>  4>  4<  4>  4<  4<  4>  4<  4<  43  4<  4<  4<  4i  4< 


IF  aSRS  .EQ.  1)  THEN 

^  34  4c  43  43 34  4c  34  4c  4c  4c  4c  4c  43  4c  43  43  4c  43  4c  43  4c  4c  4c  43  34  4c  4c  4c  4c  4>  4  43  4c  4c  43 4c  4c  43  4c  4c  4c  4c  4c  4c  4  43  4c  4  4c  4c  43  4c  4c  4c  4c  4c  4c  4c  43  4c  43  43  43  4  43  4c  4c  4c  43  4c  4c 

(^44444444444444  Neejj  (q  determine  the  depth  burnt  **4***************4t>** 

Q44444444444444444444444444444444444444444444444444444444444444444444444 

c***********  gVOL  is  THE  REMAINING  VOLUME  PER  GRAIN  *******4444444444444 

(^4444444444444444444444444444444444*4444444*4*44444444444*44444444444444 


GVOL  =  XMASG/PX  (4,  1.  1) 

IF  (GVOL  .LE.  0.0)  THEN 
WRITE  (*,  *)  'Grain  Volume  Zero  in  Depth’ 
PAUSE 
RETURN 
END  IF 


Q44444444444444444444444444444444444444444444444444444444444444444444444 

(^444444  NOW  WE  DO  THE  SPHERE.  THE  DEPTH  CAN  BE  SOLVED  DIRECTLY  ********* 

0**********************************4*****4**444*****4444****4**44**4*4** 


IF  (ITYPE  .EQ.  1)  THEN 
DB  =  A3  (8)/2.  -  (.75*GVOL/PI)**(l./3.) 

R  =  A3  (8)/2.  -  DB 
SA  =  4.*P1*R*R*A3  (46) 

GO  TO  1010 
END  IF 

0**4******4*44444**********44**44*4*4********44*444**********4***444**** 


0**4**  the  cord  with  INHIBITED  ENDS  CAN  ALSO  BE  SOLVED  DIRECTLY  •***•**♦ 


044*4444444444444444444444444444444*4444444*4444*4444444444444*444*44444 


IF  (ITYPE  .EQ.  11)  THEN 
DB  =  (A3  (8)/2.)  •  (GVOU(PI*A3  (7)))**(l./2.) 

R  =  A3  (8)/2.  -  DB 

SA  =  2.*PI*R*A3  (7)* A3  (46) 

GO  TO  1010 
END  IF 

G*********************************************************************44 
0*44**4*444*4444444444*  fHE  CIGARETTE  GRAIN  *******************4**4***** 

o*********************************************************************** 


IF  (ITYPE  .EQ.  13)  THEN 
DB  =  A3  (7)  -  (4yPI)*(GVOL/(A3  (8)*A3  (8))) 

SA  =  A3  (8)* A3  (8)*PI/4.*A3  (46) 

GO  TO  1010 
END  IF 

o*********************************************************************** 
O******************  SANDWICH  WITH  INHIBITED  SIDES  ********************* 

0*******444444*4**4***4**4*********44*4*444*******4***44*4**4***44***44* 


IF  (ITYPE  .EQ.  12)  THEN 
SA  «  2.*A3  (7)*A3  (10)*A3  (46) 

DB  =  (A3  (8)/2.)  -  (GVOL/(2.*A3  (7)*A3  (10))) 
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GO  TO  1010 
END  IF 

^  4c  4<*4<  4>  *41 4>  4>il<  Ik*  4ii|i  iti*  4iiti4>  4i  4<  <l>  4>  i*<  *  4i<|i  4<4i  Hi  >l> « i|<  4>  *  4<  >*<*  >l> « >l<  4"t<  4<  * 

^*****************  USING  NEWTON-RAPHSON  METHOD  ************************* 
^*****************  not  obtaining  UNIQUE  VALUES  WILL  NOT  USE  ************ 

Q4c***********************4c4c***4c*4c4c4c************************************* 


IF  (IMOD  .EQ.  2)  THEN 
WRITE  (•,  *)  'Using  Newton-Raphson’ 

X2  =  PX  (1,  1,  5) 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB,  X2) 
VOL2  =  VOLUNB 
PERC  =  (VOL2  -  GVOL)/GVOL 
IF  (ABS  (PERC)  .LE.  CONVRG)  THEN 
DB  =  X2 


SF  =  SFAREA*A3  (46) 

GO  TO  1010 
END  DF 

XYZST  =  (A3  (1)  -  Xl)/100. 

X3  =  X2  +  XY2ST 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB.  X3) 
VOL3  =  VOLUNB 
PERC  =  (VOL3  -  GVOL)/GVOL 
IF  (ABS  (PERC)  .LE.  CONVRG)  THEN 
DB  =  X3 

SF  =  SFAREA*A3  (46) 

GO  TO  1010 
END  IF 

1020  CONTINUE 


XI  =  X2 


X2  =  X3 
VOLl  =  VOL2 
VOL2  =  VOL3 

X3  =  (GVOL  -  VOLl)*(X2  -  Xl)/(VOL2  -  VOLl)  +  XI 
CALL  FORMT  (ITYPE,  SFAREA.  VOLUNB.  X3) 
VOL3  =  VOLUNB 

DELTAV  =  ABS  (VOLUNB  -  GVOL)/GVOL 
IF  (DELTAV  .LE.  CONVRG)  THEN 
DB  =  X3 

SA  =  SFAREA*A3  (46) 

GO  TO  1010 
END  IF 
GO  TO  1020 
END  IF 


u*********************************************************************** 

(;*»**«*4c*********  remaining  GRAINS  REQUIRE  SEARCH  ********************** 
^*********************************************************************** 

C  WILL  USE  A  BISECTION  METHOD  TO  RND  THE  DEPTH  BURNT.  CONSIDER  THE 
C  FUNCTION  WHICH  IS  THE  DIFFERENCE  BETWEEN  THE  REMAINING  GRAIN 
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C  VOLUME  AND  THE  COMPUTED  GRAIN  VOLUME  FOR  A  GIVEN  DEPTH  BURNT 
C  WE  ARE  LOOKING  FOR  THE  ROOT  OF  THIS  FUNCTION,  IT  MUST  HAVE  A 
C  UNIQUE  SOLUTION  BETWEEN  ZERO  AND  MAX  DEPTH  BURNED,  A3(l) 

^  *  Ik  4c  4>  4i  4iiti «  *  «  «  *  «  *  *  ***111 4, «  4i  *  *  4i  *  4i «  *  «  4i «  Hi «  *  *  *  *  4i  *  «  4, 1)1 *  «  *  *  *  iti  4. « i|> «  « 1)1  %  * :),  *  *  3tc  4c «  « i|i 


C  THE  THREE  X  VALUES  USED  IN  THE  METHOD  WILL  BE  X1,X2,X3  IN  THAT  ORDER 

Q*********************************************************************** 

(21****************  first  the  lower  LIMIT  FOR  THE  SEARCH  ***************** 
^*********************************************************************** 


WRITE  (*,  *)  'Using  Bisection’ 
IF  (PX  (1.  1,  5)  .GT.  0.0)  THEN 
XI  =  PX  (I,  1,  5) 

ELSE 
XI  =  0.0 


END  IF 

^*********************************************************************** 
Q*******************  test  to  see  IF  PROPER  LOWER  VALUE  ***************** 
^*******************  gvol-volunb  less  than  zero  ************************ 

^4c*4c4<4>4>4>*******************4<4c4i4i4c4c4c4c4i4<4i4>4c4c4i4c4c4c4c4c4c4c4c4c4<4i4i4c4c4c*4c***4>**4i4c4<**** 


XYZST  =  (A3  (1)  -  Xl)/10000. 

XYZST  =  ABS  (XYZST) 

1030  CONTINUE 

CALL  FORMT  (TTYPE,  SFAREA,  VOLUNB,  XI) 
FUNCT  =  GVOL  -  VOLUNB 
IF  (FUNCT  .GE.  0.0)  THEN 
XI  »  XI  -  XYZST 
IF  (XI  .LE.  0.0)  THEN 
XI  =  0.0 


CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB,  XI) 
GO  TO  1040 
END  IF 
GO  TO  1030 
END  IF 


^4<*4i*4i*4i**4i4<***********4i4i*4i4c4>**********4i***4i**k***4c4i4c4c4<4c4c4c4c4c*4c4i4c4'4i4i4c4i4i4c4c 


C*********  NEXT  THE  UPPER  LIMIT  FOR  THE  BRACKET  IS  FOUND  *************** 

^4>4iik4>**********4i***4i4i*4c****4i4i4i4i4i4>4>4i4>**<k4i4i4i4c4'4>4i4'4c4iik4i4'4>4i4i4i4'4i4c*4c4>4'4i******4'4> 

1040  CONTINUE 
JSTOP  =  0 

XYZST  =  (A3  (1)  -  XD/IOOOO. 

1050  CONTINUE 

JSTOP  =  JSTOP  -f  1 
IF  (JSTOP  .EQ.  10001)  THEN 
X3  =  A3  (1) 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB,  X3) 

GO  TO  1060 
END  IF 

C  X3»Xl+JSTOP*XYZST 
X3  =  XI  +  XYZST 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB,  X3) 
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^  *  Ifiik  *  sti  4i  *  1^  4I  ^  4>  <|I  4<  4i  4<  Ik  Ik  Hi  III  >)<  4<  4<  4<  %  I|>  *  *  4>  4<  Ik  «  *  *  *  4<  4i  It<  41 4' >•>  Ik  >l>  *  %  >t<  4>  I|<  >•>  >l>  <t<  %  4<  >!■  *  ><<  4<  Ik  *  414' 

^4i«4i4i4i4i4i4ii|c4i4i4i4i4i4i4i  §££  Jp  HAVE  A  MATCH  *'k*'k4iikikikikikik4i4i4i4iikkik4iik4i4<4i4i4i4i4i4i4i4i4i 

^  *  4i  4<  4i  4i »  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  *  4i  4>  Ik  4i  4i  4<  4i  4i  4<  4i  k  4i  4i  4<  4i  4>  *  4i  4i  4i  4i  4i  4i  Ik  4i  4i  4i  4i  Ik  4i  4i  4i  4>  Ik  4<  4i  Ik  4i  4i  4<  4>  4<  4<  4i  4i  4i  4i  * 

FUNCT  =  GVOL  -  VOLUNB 
IF  (ABS  (FUNCT)  .LT.  .000001)  THEN 
DB  =  X3 

SA  =  SFAREA*A3  (46) 

GO  TO  1010 
END  IF 

IF  (FUNCT  .LE.  0.0)  THEN 
XI  =  X3 
VOLl  =  VOL3 
GO  TO  1050 
END  IF 

VOL3  =  VOLUNB 
1060  CONTINUE 

^  4i  4i  4i  k  *  4<  4i  4i  4i  4i  *  4i  4i  4i  k  4i  4i  4!  4i  4i  4i  4i  4i  4i  4i  4i  Ik  4<  4i  Ik  4i  4i  4i  4i  4<  4i  4<  4i  4i  Ik  4i  4i  4<  4i  4i  4i  4i  4>  4i  4i  Ik  4i  Ik  4i  4i  4>  4i  4<  4>  Ik  4<  4<  4<  4i  4i  4<  41 4<  Ik  4i  4i 

^kkkkkkkkkkkkkkkkkk  BRACKET  HAS  BEEN  FOUND  kkk4ikkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(;;kkkkkkkkkkkk  NOW  WE  START  THE  BISECTION  METHOD  kikkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

Qkkkkkkkkkkkkkk  nRST  THE  MIDPT  IS  COMPUTED  **************************** 

Qkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

1070  CONTINUE 

X2  =  (XI  +  X3)/2. 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB.  X2) 

F2  =  GVOL  -  VOLUNB 
PERC  =  F2/GVOL 

IF  ((ABS  (PERC)  .LT.  CONVRG)  .OR.  (ABS  (X3  -  XI)  .LT.  .000001))  THEN 
DB  =  X2 

SA  =  SFAREA*A3  (46) 

GO  TO  1010 
END  IF 

IF  (F2  .GT.  0.0)  THEN 
X3  =  X2 
ELSE 
XI  =  X2 
END  IF 
GO  TO  1070 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkkkkkkkkkkkkkk  all  depth  burned  AND  SURFACE  ARE  FOUND  ************* 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

1010  CONTINUE 
PX(1.  1,5)  =  DB 
IF  (IFLAG  .EQ.  2)  THEN 
RETURN 
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ELSE 

DO  1080  ICH  =  2.  i  1 
PX  (ICH,  1,  5)  =  PX  aCH.  1,  1) 

1080  CONTINUE 
RETURN 
END  IF 
END  IF 

^  « ikitiitiitiili «!  1)1 4t  *  1)1 4i  *  41  If  41  *  *  4iit>  4> «  4> « 1)1 4>  *  4i  *  *  *  *  «  4»)i  *  >t>  >l<  >*■  i|<  >*<  4<  *  *  *  «  4c  «  *  *  «  *  « 4<  4>  >l<  *  «  * 

^4c4i4c4c4c4c4i4c4c4c4c4i44<4c4c4>4c4'4'4c  NQW  CONSTANT  PROPERTIES  WITH  ******************** 
(2;4>4<4<4<4<4.4.4<4>4>4>4i4<4i4>4>4.4i*44>  SEVERAL  LAYERS  -  NOT  DETERRED  ******************* 

^  4c  4t  4i  4i  4  4<  4i  4<  4<  4>  4>  4>  4>  4c  4<  4i  4i  4i  4i  4i  4i  4c  4i  4<  dc  4i  41 >•>  41 4>  4<  4c  4>  4c  *  4>  4c  4>  4c  4i  4i  4i  4i  4i  4<  4' 4c  4<  4>  4' 4>  4c  4<  4c  4c  4<  4<  4t  4<  4c  4<  4c  4>  4<  4<  4<  4<  4i  4c  4< 

IF  (ISRS  .EQ.  2)  THEN 
GO  TO  1090 
1100  CONTINUE 
PX  (1.  J.  5)  =  DB 
IF  (IFLAG  .  EQ.  2)  THEN 
RETURN 
ELSE 

DO  1110  ICH  =  2.  11 
PX  (ICH,  J,  5)  =  PX  (ICH,  J,  1) 

1110  CONTINUE 
RETURN 
END  IF 

(>4c44c4c44.4c4c4c4c4.44<4c44c4c4.4  j^fEED  VOLUME  OF  LAYERS  BELOW  CURRENT  LAYER  ■»•******** 

1090  CONTINUE 

WRITE  (*,  *)  ’Using  Bisection:  Layered  Grain’ 

GGVOL  =  0.0 
DO  11201  =  J  +  1,  NL 
GGVOL  =  GGVOL  +  PX  (8, 1,  3) 

1120  CONTINUE 

(;<4c4c4.4c4.4c4c4c4c4.4c4c4c4.4c4c4c4c  TARGET  IS  UNBURNED  VOLUME  IN  LAYER  **4c4c4c4c4c4c4.4c*4c4c4c4.4c4c 

TARGET  =  (PX  (4,  J,  3)  -  XMB)/PX  (4,  J,  1) 

^4*.4444C*44.**44C4C44*44C.»4.*  f^EED  BRACKET  FOR  SEARCH,  BISECTION  METHOD  **••** 

IF  (PX  (1,  J,  5)  ,GT.  0.0)  THEN 
XI  »  PX  (1,  J,  5) 

ELSE 

XI  =  PX(1,  J,  1) 

END  IF 

^  4c  4c  4c  4c  4c  4>  4c  4i  4c  4c  c4  4c  4c  *  4c  4c  4c  ck  c*  4c  c4  4c  c»  4c  4c  4c  *  4c  4c  i4  4c  4c  4c  4c  4c  4c  4c  4c  c4  4c  4c  4c  4c  4c  c4  4  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  c4  4  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 
(34444444444444444444  JEST  TO  SEE  IF  PROPER  LOWER  VALUE  •********•***■»*** 
^4444444444444444444  TARGET-TESTV  LESS  THAN  ZERO  ****************|***4444 
Q4444444I;  444444444444444444444444444444444444444444444444444444444444444 

IF  (J  .EQ.  NL)  THEN 
ENDL  *  A3  (1) 

ELSE 

ENDL  B  PX  (1,  J  +  1.  1) 

END  IF 

XYZST  =  (ENDL  -  Xl)/10000. 
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XYZST  =  ABS  (XYZST) 

1130  CONTINUE 

CALL  FORMT  (TTYPE.  SFAREA.  VOLUNB,  XI) 
TESTY  =  VOLUNB  -  GGVOL 
FUNCT  =  TARGET  -  TESTY 
IF  (FUNCT  .GE.  0.0)  THEN 
XI  =  XI  -  XYZST 
IF  (XI  .LT.  PX  (1.  J,  1))  THEN 
XI  =  PX  (1.  J,  1) 

GOTO  1140 
END  IF 
GOTO  1130 
END  IF 


^  *  4>  Itiitt  4ri|iiti  *  *  *  « III  41  *  4>  *  *  «  41  *  4>  1|<  *  *  *  *  41 4> «  *  *  *  *  *  *  *  *  *  1|>  *  *  4>  111  4>  4i  >|i  4>  ^  >«>  *  «  *  *  *  4>  41  *  *  *  *  4: 


C*********  NEXT  THE  UPPER  LIMIT  FOR  THE  BRACKET  IS  FOUND  *************** 

^4i*********4i4i4i4<**********4i*4i4i****4i*4i4i4i4i44i******************************* 


1140  CONTINUE 
JSTOP  =  0 
1150  CONTINUE 

JSTOP  =  JSTOP  +  1 
IF  (JSTOP  .EQ.  10001)  THEN 
IF  (J  .EQ.  NL)  THEN 
X3  =  A3  (1) 

ELSE 

X3  =  PX(1.  J+  1,  1) 

END  IF 

CALL  FORMT  (TTYPE,  SFAREA.  VOLUNB,  X3) 

TESTY  =  VOLUNB  -  GGVOL 

PERC  =  (TARGET  -  TESTV)/PX  (8.  J,  3) 

IF  (ABS  (PERC)  .LE.  CONVRG)  THEN 
SA  =  SFAREA*A3  (46) 

DB  =  X3 
GOTO  1100 
END  IF 
GOTO  1160 
END  IF 


X3  =  XI  +  XYZST 


CALL  FORMT  (TTYPE,  SFAREA.  VOLUNB.  X3) 


^»4i**»*******************************************4i4i***4i*4i*****44i4i44i*4*** 


c 


SEE  IF  WE  HAVE  A  MATCH  ******************************* 


^4i4i4i4i4i4i**4i4i4i4i4i4i4i*44i44***4r4i*»44i44i44i4i4i4i4i4i*4i44i4i4i4i4i444i4i4i4i4i4i4<4i4i************** 

TESTV  =  VOLUNB  -  GGVOL 

PERC  =  (TARGET  -  TESTV)/PX  (8.  J.  3) 

IF  (ABS  (PERC)  .LT.  CONVRG)  THEN 
DB  s  X3 

SA  s  SFAREA* A3  (46) 

GOTO  1100 
END  IF 
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FUNCT  =  TARGET  -  TESTV 
IF  (FUNCT  .LE.  0.0)  THEN 


XI  =X3 
GO  TO  1150 
END  IF 

1160  CONTINUE 

^  *  4i  4i  *  «  *  «  *  Ik  *  *  <1  *  *  *  *  *  *  111 »  *  41 4i  4< «  4i  *  4i  *  «i  *  *  *  **  1(1 4>  Hi  *  *  4c «  *  «  *  :(■  «*  *  i|nt<  *  i|c  4>  4c  itc  %  1)1  %  Dc  Ik  41 4<  « 

^4i4i4c4c4i4c4c4i4c4i4i4i4i4i4c4iik4i  BRACKET  HAS  BEEN  FOUND  '•"•‘■•‘■I’ CO*** 

^  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4i  4c  4i  4<  4i  4i  4i  4<  4i  4i  4i  4>  4<  4i  4i  4<  4i  4i  4<  4i  4i  4i  4i  4i  4>  4i  4i  4c  4  4>  4' 4i  4c  4c  4>  4>  4i  4i  4i  4<  4i  4>  4i  4i  4i  4i  4i  4i  4i  4>  4>  4<  4>  4i  4c  4  4>  4i  4c  4>  4> 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4i  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c 

C************  NOW  WE  START  THE  BISECTION  METHOD  444444444444444444444444 
^44444444444444444444444444444444444444444444444444444444444444444444444 
(^44444444444444  FIRST  THE  MIDPT  IS  COMPUTED  4444444444444444444444444444 
(^44444444444444444444444444444444444444444444444444444444444444444444444 

1170  CONTINUE 


X2  =  (XI  +  X3)/2. 

CALL  FORMT  (TTYPE,  SFAREA,  VOLUNB,  X2) 

TESTV  =  VOLUNB  -  GGVOL 
F2  =  TARGET  -  TESTV 
PERC  =  F2/PX  (8.  J,  3) 

IF  ((ABS  (PERC)  .LT.  CONVRG)  .OR.  (ABS  (X3  -  XI)  .LT.  .000001))  THEN 
DB  =  X2 

SA  =  SFAREA*A3  (46) 

GOTO  1100 
END  IF 

IF  (F2  .GT.  0.0)  THEN 
X3  =  X2 
ELSE 
XI  =  X2 
END  IF 
GOTO  1170 
END  IF 

(^44444444444444444444444444444444444444444444444444444444444444444444444 

(^4444444444444444444  LOWER  LIMIT  OF  INTEGRATION  ******************** 
(^44444444444444444444444444444444444444444444444444444444444444444444444 

XS  =  PXd.J.  1) 

. . 444444 

C  Need  to  determine  an  interval  for  the  upper  limit  of  integration 
C  will  then  use  a  bisection  method  to  detenminc  the  depth  burned. 

. . 44444444444444444 

C******  FIRST  THE  MAXIMUM  POSSIBLE  UPPER  LIMIT  IS  DETERMINED 

. . 4444444444444444444444444444444 . 444444 


IF  (J  .EQ.  NL)  THEN 
XMAX  s  A3  (I) 

ELSE 

XMAX  =  PX(1,  1,  1) 

END  IF 
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****  4i4i  4^  **  4i  ****  III  1(1  i(<  111*  4<  4>  4' *  *  il<  i*t  4<  >*>*')<  **  >l<  *>l<  4< ’l<  4>  >*■* * 

C********  NEXT  THE  INTERVAL  FOR  THE  UPPER  LIMIT  IS  DETERMINED  ********** 

^****4i***4i4i*4i*4i4i4i**4i**4i4i*4i4i4i4i4i4i4i4i4<4i4i4<4i4>4i4i4i4i4i4i4i4i4i4i4<4<4i4i4>4i4i4i4i4i4i  41*41 414<4<4<41 41 414141 

(^***************  cy^sE  I:  WE  HAVE  INTEGRATED  ON  THIS  LAYER  BEFORE  ******* 
^*********************************************************************** 


IF  (PX  (4,  J,  5)  .GT.  0.0)  THEN 
IF  (PX  (4,  J,  5)  .EQ.  XMB)  THEN 
DB  =  PX  (I.  J,  5) 

CALL  FORMT  (ITYPE,  SFAREA.  VOLUNB.  DB) 
SA  =  SFAREA*A3  (46) 

IF  (IFLAG  .EQ.  2)  THEN 
RETURN 
ELSE 

CALL  IGRALS  (XS.  J.  DB) 

RETURN 
END  IF 

ELSE  IF  (PX  (4.  J,  5)  .GT.  XMB)  THEN 
XL^PX(1,  J.  5) 

VAL  =  PX  (4.  J,  5) 

Q  =  (XL  -  PX  (I.  J,  1))/10. 

DO  1180  II  =  1.  10 
XR  =  XL-Q 
IF  (XR  .LE.  XS)  THEN 
XR  =  XS 


VAR  =  0.0 


GOTO  1190 
END  IF 

XDEL  =  XR  -  XS 
XSl^EP  =  XDEL/300. 

PDEL  »  PX  (4.  J.  2)  -  PX  (4,  J.  I) 
XDELl  =  XMAX  -  XS 


SUM  =  0.0 
DO  12001  =  1.  301 
XI  =  XS  +  (1  -  D^XSTEP 
CALL  FORMT  (ITYPE,  ASURF,  VOLUNB.  XI) 

FCN  =  ((PDEL/XDEL1)*(XI  -  XS)  +  PX  (4.  J.  1))* ASURF 
IF  ((I  .EQ.  1)  .OR.  (I  .EQ.  301))  THEN 
SUM  =  SUM  +  FCN 
ELSE 

SUM  =  SUM  +  2.*FCN 
END  IF 

1200  CONTINUE 

SUM  *  SUM*(XDEL/600.) 

IF  (SUM  .EQ.  XMB)  THEN 
DB  s  XR 


PX  (1.  J.  5)  =  DB 
PX  (4.  J.  5)  »  SUM 

CALL  FORMT  (ITYPE,  SFAREA.  VOLUNB.  DB) 
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SA  =  SFAREA*A3  (46) 

IF  (IFLAG  .EQ.  2)  THEN 
RETURN 
ELSE 

CALL  IGRALS  (XS.  J.  DB) 

RETURN 
END  IF 

ELSE  IF  (SUM  .LT.  XMB)  THEN 
VAR  =  SUM 
GOTO  1190 
ELSE 
XL  =  XR 
VAL  =  SUM 
END  IF 

1180  CONTINUE 
ELSE 

XR  =  PX  (1,  J.  5) 

VAR  =  PX  (4,  J.  5) 

Q  =  (XMAX  -  XR)/10. 

DO  1210  11=  1.  10 
XL  =  XR  +  Q 
IF  (XL  .GT.  XMAX)  THEN 
XL  =  XMAX 
VAL  =  PX  (4.  J,  3) 

GOTO  1190 
END  IF 

XDEL  =  XL  -  XS 
XSTEP  =  XDEL/300. 

PDEL  =  PX  (4,  J.  2)  -  PX  (4.  J.  1) 

XDELl  =  XMAX  -  XS 
SUM  =  0.0 
DO  1220  I  =  1.  301 
XI  =  XS  +  (I  -  1)*XSTEP 
CALL  FORMT  (ITYPE,  ASURF.  VOLUNB.  XI) 

FCN  =  ((PDEL/XDELI)*(XI  -  XS)  +  PX  (4,  J.  1))*ASURF 
IF  ((I  .EQ.  I)  .OR.  (I  .EQ.  301))  THEN 
SUM  =  SUM  +  FCN 
ELSE 

SUM  =  SUM  +  2.*FCN 
END  IF 

1220  CONTINUE 

SUM  «  SUM*(XDEL/600.) 

IF  (SUM  .EQ.  XMB)  THEN 
DB  «  XL 
PXd.J,  5)»DB 
PX  (4.  J.  5)  =  SUM 

CALL  FORMT  (ITYPE.  SFAREA.  VOLUNB.  DB) 

SA  =  SFAREA*A3  (46) 
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non 


EF  (IFLAG  .EQ.  2)  THEN 
RETURN 
ELSE 

CALL  IGRALS  (XS.  J.  DB) 
RETURN 
END  IF 

ELSE  IF  (SUM  .GT.  XMB)  THEN 
VAL  =  SUM 
GOTO  1190 
ELSE 
XR  =  XL 


VAR  =  SUM 
END  IF 

1210  CONTINUE 
END  IF 
ELSE 

^  *  *  *  *  «  *  «  *  «  *  *  4i  *  *  *  *  *  *  4i  *  «  *  «  4i  *  «  *  1)1 «  «  «  4i  *  «  4i  4ii|i  III  4. 41  *  »  41 41 41  *  *  Hi «  *  4c «  «  «  *  *111 

^4i4i4<4i4<4>4i4>*4<***4i4i4i4i4i4<4i  PREVIOUS  INFORMATION  ***************‘*******‘'>‘*** 

Q:t‘’¥<¥*'¥***$iitt******’tt*********************************<¥******************  ** 

XR=  XS 
VAR  =  0.0 
XL  =  XMAX 
VAL  =  PX  (4.  J.  3) 

END  IF 

1 190  CONTINUE 

(^4i4i**4i*****4>***4i*4i**4'4i4i4i4i4i4i4i4i4i4i  41*41 4i4i4i4i4i4<*4i***4i4i****4>4i4i4i4i*4i*4i»»4>**4i4i«>*4i4i4i 

C^***************  midpoint  used  to  find  depth  *************************** 
^*********************************************************************** 
(;****************  TEST  to  end  THE  SEARCH:  DELTA  X  <  .00001  ************* 

^****************************************************************41****** 

XDELTA  =  XL  .  XR 
IF  (XDELTA  .LT.  .00001)  THEN 
DB  =  (XL  XR)/2. 

PXd.J,  5)=  DB 

PX  (4.  J.  5)  »  (VAL  +  VAR)/2. 

CALL  FORMT  (ITYPE,  SFAREA,  VOLUNB.  DB) 

SA  =  SFAREA*A3  (46) 

IF  (IFLAG  .EQ.  2)  THEN 


RETURN 

ELSE 

CALL  IGRALS  (XS.  J.  DB) 
RETURN 
END  IF 
END  IF 


N******  integration  is  performed  FOR  MIDPOINT 

»*****«****»*»*************************************4 

XTRY  «  (XL  +  XR)/2. 
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XDEL  =  XTRY  -  XS 
XSTEP  =  XDEL/300. 

PDEL  =  PX  (4,  J,  2)  -  PX  (4.  J,  1) 

XDELl  =  XMAX  -  XS 
SUM  =  0.0 
DO  1230  I  =  1.  301 
XI  =  XS  +  a  -  1)*XSTEP 
CALL  FORMT  (TTYPE.  ASURF,  VOLUNB,  XI) 

FCN  =  ((PDEL/XDEL1)*(XI  -  XS)  +  PX  (4.  J,  1))*ASURF 
IF  (0  .EQ.  1)  .OR.  a  EQ.  301))  THEN 
SUM  =  SUM  +  FCN 
ELSE 

SUM  =  SUM  +  2.*FCN 
END  IF 

1230  CO.'ITINUE 

SUM  =  SUM*(XDEL/600.) 

PERC  =  ABS  ((SUM  -  XMB)/XMB) 

DF  (PERC  .LT.  CONVRG)  THEN 
DB  =  XTRY 
PX(1,  J,  5)  =  DB 
PX  (4.  J,  5)  =  SUM 

CALL  FORMT  (ITYPE,  SPARE  A,  VOLUNB,  DB) 

SA  =  SFAREA*A3  (46) 

IF  (IFLAG  .EQ.  2)  THEN 
RETURN 
ELSE 

CALL  IGRALS  (XS.  J.  DB) 

RETURN 
END  IF 

ELSE  IF  (SUM  .LT.  XMB)  THEN 
XR  =  XTRY 
VAR  =  SUM 
GOTO  1190 
ELSE 

XL  =  XTRY 
VAL  =  SUM 
GOTO  1190 
END  IF 
RETURN 
END 

^  *1)1  ***««*«*  *41  *  4>  4iiti  itr  4<4i*  4<  **  4>  4i  *  ***41  Irif  *  Ik  **  it>  Ki  i<<  *  4<  **  iti  *  « 

c* 

^********************  SUBROUTINE  FORMT  *****•*♦********><■****’•■********•** 
C* 

^**************************************1)1******************************** 

c* 

C  ICODE:  code  for  type  of  grain 
C  R  :  bum  depth 
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C  GL:  unbumed  grain  length 

C  D  ;  unbumed  outer  diameter 

C  PD:  unbumed  perforation  diameter 

C  WI,  WM,  WO:  inner,  middle  and  outer  webs  respectively 
C 

C  Output: 

C  SFAREA:  surface  area 

C  FRCSFA:  surface  area/initial  surface  area 

C  VOLUNB:  unbumed  volume 

C  VOLBRN:  burned  volume 

C  FRCBRN:  burned  volume/initial  volume 

C  VOLMAO:  unbumed  volume  of  outer  layer 

C  VOLMBO:  unbumed  volume  of  inner  layer 

C  VOLABR:  burned  volume  of  outer  layer 

C  VOLBBR:  burned  volume  of  inner  layer 

C 

^  III  %  i|< « t  >t>  <1 «  4<  %  4141  i«i  4<  i|<  4<  *  i|<  **  4<  *  Hi  it<  4<  it>  <t<  >•<  Ik  **  <)•<«><•>*  I*!  **  4<  4>  ♦  I*' <l<  4<  >*■<*>  >*<><<<•■%  >*> 


SUBROUTINE  FORMT  (ICODE,  SFAREA.  VOLUNB,  R) 
COMMON  /ARRAYS/  A3  (100),  PX  (11.  15.  5) 
DIMENSION  S7  (4).  S19  (3.  4) 

DATA  RT/1 .732050808/,  PI3/1 .047 197551/,  PI/3.141592654/ 


Q  4i  4i  4i  4i  4<  4i  4>  4i  4>  *  4<  4<  4<  4>  41 4i  4<  4<  4^  4>  *  4' 4i  4<  4<  4' 4<  4>  4^  4>  4>  4i  4c  4<  4i  4<  4' *  4<  4<  4<  41 4<  4c  4i  41 4<  4>  4<  4<  4<  4<  4i  4c  41 4t  4>  4>  4' 4<  4t  4>  4>  4>  4<  4<  4>  *  4<  4>  4< 


^4c4c4c4c4c4c4c4c4<4c*4c4c4c4c4<4c4'4c4>  gEX  GRAIN  GEOMETRY  ********’*******************'*‘*** 


^  4c  4c  4c  4c  4' 4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4t  4c  4c  4c  4c  4c  4c  4c  4c  4(  ♦  4i  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


GL  =  A3  (7) 

D  =  A3  (8) 

PD  =  A3  (9) 
WI  =  A3  (10) 
WM  =  A3  (11) 
WO  =  A3  (12) 


^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4  4>  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


C********  Set  U  =  2*(depth  burned)  and  branch  to  grain  type  ************ 

^4444444444444444444444444444444444c44c4444444444444444444444444  44*4444  444 


U  =  2.0*R 


^44444444444444444444444444444444444444444444444444444444444444444444444 
^4444444444444444444444  CIGARETTE  GRAIN  44444.|c*4*44444444444444444444444 
^44444444444444444444444444444444444444444444444444444444444444444444444 


IF  (ICODE  .EQ.  13)  THEN 
SFAREA  =  PI*D*D/4. 

VOLUNB  =  (GL  -  R)*SFAREA 
RETURN 
END  IF 

^4444444444444444444444444444444444444444444*444444444444444444444444444 
(^444444444444*4444  OTHER  GRAINS  ARE  HANDLED  4*4************44*4*4*** 

(^44444444444*44444444444444444444444*4444444444*4444 44444444i»  444444444  44 

GO  TO  (  1000,  1010,  1020,  1030.  1040,  1050.  1060,  1070, 

1  1080,  1090,  1100.  1110),  ICODE 

(^44444444444*4444444444444444444444444444444444*444444444444444444444444 
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CODE  1 :  7-PERF  GRAIN  *********************'*"f***** 

^  «  «  *  *  *«  Hi  *  «  *  *41 «  4> »  4>  *  *  *  •  *  *  *  4«|iitiiti  4<  4i  4- 4: 4t  *  «  »  4>  *  «>  *  *  4<  *  *  «  « it>  >•■  %  *  >K  *  *  *<•>  4>  4>  *  *  *  *  4"t>  >•<  *  4>  4»*  >•>  *  4< 


C***  This  part  calculates  the  conditions  before  the  grain  bums. 

^**4cii*****4i****4i***iti*i|<*i|i****4i*****************************it>************* 

1050  CONTINUE 


D  =  3.0*PD  +  2.0*(WI  +  WO) 

EO  =  PI*(D**2  -  7.0*PD**2)/4.0 
SO  =  PI*(D  +  7.0*PD)*GL  +  2.0*E0 
VO  =  E0*GL 


WW  =  WI  +  PD 
DO  1120  K  =  1.  3 
S7  (K)  =  WW 
1120  CONTINUE 

WEBC  =  AMINl  (WO.  WI,  GL) 


C***  This  part  does  the  calculations  for  the  burning  grain. 

^******4ii|iiti*4>4i***********4i*4i***4i*%*************************************** 


GRL  =  AMAXl  (GL  -  U.  0.0) 
OD  =  D  -  U 


PRFD  =  PD  +  U 

IF  (U  .GT.  WEBC)  GO  TO  1 130 

E  =  PI*(OD**2  -  7.0*PRFD**2)/4.0 

SFAREA  «  PI*(OD  +  7.0*PRFD)*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  E*GRL 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRNA^O 

RETURN 


^i|c4i**4>4ii|i***4(4i**it:**4<***4i*4iitt****i|iitii|i*«*******i|>***********i|ci|c**************** 


C***  This  part  does  the  calculations  for  when  the  grain  slivers,  ****** 

Q*********************************************************************** 

1130  CONTINUE 

CALL  GENIS  (S7.  PRFD,  GRL,  SFl,  GVl) 

CALL  GENOS  (S7.  PRFD.  GRL,  0.5*OD.  SF2.  GV2) 

SFAREA  =  6.0*(SF1  +  SF2) 

FRCSFA  =  SFAREA/SO 
VOLUNB  =  6.0*(GV1  +  GV2) 

VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

^*****************111*  CODE  2:  1-PERF  GRAIN  **************************** 

Qltlti**:^!***:*^^*^,^**^******************************************************* 

C***  This  part  calculates  the  conditions  before  the  grain  bums, 

^  *  4, 4<*>(>  4>  111  «<  4i  *  4>  Ik*  4>  4<  *******  *4i*>4' 4>  4>  *  i|<  *  41*41 4> «  4>  >t>  4<  *  4i  >t<  Hi  4<  it>  it<  i|>  tot!  >*<  4<  4<  *  4iiti  4ii|c  *  it>  4i  >l<  *  it<  it<  itoti  4> 

1030  CONTINUE 
D  =  PD  +  2.0*WI 
EO  =  PI*(D**2  -  PD**2)/4.0 
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so  =  P1*(D  +  PD)*GL  +  2.0*E0 
VO  =  EO*GL 


WEBC  =  AMINl  (GL.  WI) 

^  *  4i  *  *  4c  4>  4>  *  *  41 «  *  4<  *  4c  *  «  «  «  4i  *  Ik  *  *  Ik  *  *  *  *  *  «  «  «  «  *  4< «  4>  *  *  *  *  i|<  4<  4<  *  4>  41*  *  i|< «  4<  «  4iit> 

C*******  This  part  does  the  calculations  for  the  burning  grain.  ******* 

^  4c  4>  4c  4<  4i  4c  4c  4>  4c  4i  4<  4<  41 4>  *  4>  41 4c  4' 4>  4i  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4i  4i  4>  4' 4' 4c  4>  4c  4c  4>  4i  4i  4>  4i  4c  4c  4c  4c  4<  Ik  4c  4i  4>  4c  4c  4<  4<  4i  4i  4c  4c  4c  4c  4i  4i  4i  4c  4c  4i  4c 


IF  (U  .GE.  WEBC)  THEN 
GRL  =  0.0 
E  =  0.0 
GOTO  1140 
END  IF 


GRL  =  GL  -  U 
OD  =  D  -  U 


PRFD  =  PD  +  U 
E  =  PP  (OD**2  -  PRFD**2)/4.0 
1140  CONTINUE 

SFAREA  =  PI*(OD  +  PRFD)*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  E*GRL 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRNA'O 

RETURN 


^  4c  4c  *  4c  4c  4c  4c  Ik  4c  4c  4i  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 

Q4i 4c 4c 4c 4c 4c 4c 4c 4c Ik 4c 4c 4c 4c 4c 4c 4c 4c 4c  CODE  3"  CORD  GRAIN  ****************************** 

^  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  Ik  4c  4c  4c  4c  Ik  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  k  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  Ik  4c  4c  4c  4c  4' 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c 

C***  This  part  calculates  the  conditions  before  the  grain  bums.  ****** 

^444444444444*44*4444444444444444444444444444444444444444444444*44444444 


1010  CONTINUE 

SO  =  GL*PI*D  +  PI*D**2/2.0 
VO  =  GL*PI*D**2/4.0 

C***  This  part  does  the  calculations  for  the  burning  brain. 
GRL  =  AMAXl  (GL  -  U.  0.0) 

OD  =  AMAXl  (D  -  U.  0.0) 

E  =  PI*OD**2/4.0 

SFAREA  =  PI*OD*GRL  +  2.0*E 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  GRL*PI*OD**2/4.0 

VOLBRN  n  VO  -  VOLUNB 

FRCBRN  =  VOLBRN/VO 

RETURN 


^44444444444444444444444444444444444444444444444444444444444444444444444 
(^4444444444444444444  CODE  4:  RECTANGULAR  STRIP  GRAIN  4444444444444444 


(<44444444444444444444444444444444444444444444444444444444444444444444444 


1020  CONTINUE 


SO  =  2.0*(GL*D  +  D*WI  +  GL*WI) 
VO  =  GL*D*WI 


GRL  =  AMAXl  (GL  -  U.  0.0) 
DS  =  AMAXl  (D  -  U.  0.0) 
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>MS  =  AMAXl  (WI  -  U,  0.0) 

SFAREA  =  2.0*(GRL*DS  +  DS*WIS  +  WIS*GRL) 

FRCSFA  =  SFAREA/SO 
VOLUNB  =  GRL*DS*WIS 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRNA'O 
RETURN 

^  4»|i  *  *  Ik  *  4i  4i  *  *  Ik  i|>  *  *  « 4<  4>  ■•<  <<  4>  *  4. 4<  *  *  4>  *  it<  4i  *  4>  *  4^  i|<  i|<  it<  *  *  *  *  *  *  4<  >l<  4<  4<  *  >l<  i|«t> «  * 


^4iikikikikik4<ik4i44i4>4i4i*ik4i4i*  CODE  S'.  SPHERICAL  GRAIN  ************************* 

^4i4c4«4i*ik4i4i4[4i*4i4i4iik4i4<44i4i4i4iik44iik4i4ik4444i*ik444ikik44>ik4iik44>ikikik«<4<44444<4i4iik*ik4<ikikik4>ikik4 

1000  CONTINUE 
SO  =  PI*D**2 
VO  =  PI*D**3/6.0 
OD  =  AMAXl  (D  -  U.  0.0) 

SFAREA  =  PI*OD**2 


FRCSFA  =  SFAREA/SO 
VOLUNB  =  PI*OD**3/6.0 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

^4iikikikik4iikik4>4i4i44i4ikik**ikik4*44<44444i4i4ikikikik44"k4>444ikikikikikikik>kik4>k4<ik44i4<ik4<ikikikikikikik4iik4<* 

^4ikik4ikik*44i4444»4iikik4  CODE  6:  SLOTTED-TUBE  GRAIN  *********************** 

Q*iiti,tiiif**********************************i‘******************************* 


C***  This  part  does  the  calculations  before  the  grain  bums.  ********** 

^4ikikik4<*4ik4i4i4iik4i4i4*****ikik***«***4i4i***4iikik*ik*«***4<***ik4>ik*ik***ik*ikik*4********* 

1040  CONTINUE 
SLOT  =  0.5*WM 
SO  =  0.5*D 


SI  =  0.5*PD 

THEFA  =  ASIN  (SLOT/SO) 

ALPHA  =  ASIN  (SLOT/SI) 

EO  =  (PI  -  ALPHA)*(SO**2  -  SI**2)  +  (SO  -  SI)**2*ALPHA 

SO  =  2.0*((PI  -  ALPHA)*SI  +  (PI  -  THETA)*SO  +  (SO*COS  (THETA) 

1  -  SI*COS  (ALPHA)))*GL  +  2.0*E0 

VO  =  GL*E0 

WI  =  SO  -  SI 


WEBC  =  AMINl  (GL,  WI) 

^4iik**4i*4i***4i****4ikik44<4i**4i4i4i*4iik4<ikik44iikik4i4>ik4i4i4i4i4i4i4<ikik444<4<444444ikik>kikikik4<ik4i44<** 

C***  This  part  does  the  calculations  for  the  burning  grain.  *********** 

^«ik*ikik4i4i*4i4i4i*ikikik4i4i4i44<4i4r4i4iik44iik*ikikikik4i4<44<ikik4i444iik4i44<ik4iik4<444i4<4*44**ik*ik4<ikik444i* 


IF  (U  .GE.  WEBC)  THEN 
GRL  =  0.0 
E  =  00 
GO  TO  1 150 
END  IF 

SLOT  =  0.5*(WM  +  U) 

50  =  0.5*(D  -  U) 

51  =  0.5*(PD  +  U) 
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GRL  =  GL  -  U 

THETA  =  ASIN  (SLOT/SO) 

ALPHA  =  ASIN  (SLOT/SI) 

E  =  (PI  -  ALPHA)*(SO**2  -  SI**2)  +  (SO  -  SI)**2*ALPHA 
1150  CONTINUE 

SFAREA  =  2.0*((PI  -  ALPHA)*SI  +  (PI  -  THETA)*SO  +  (SO*COS  (THETA) 

1  -  SI*COS  (ALPHA)))*GRL  +  2.0*E 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  E*GRL 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

^  A  *111  i|i  >)<  *111  111  Hi  III  4i  *  4i  *  *  *  *  «  *  *  i|i  **  *  *  4i  4' O' <l<  >(<  4>  <l<  I*  4<  <(■  4>  i|>  III  4i  4<  *  4<  *  4<  •k  4> 

(^*******************  CODE  7:  ROUND-HEX  37-PERF  GRAIN  ♦♦♦f************* 

C** ********************************************************* ************ 

1090  CONTINUE 

50  =  18. 

51  =  54. 

NPERF  =  37 

D  =  7.0*PD  -t-  6.0*WI  +  2.0*WO 
GOTO  1160 

c*********************************************************************** 
C*******************  CODE  8:  ROUND-HEX  19-PERF  GRAIN  ***************** 
c*********************************************************************** 
1080  CONTINUE 

50  =  12.0 

51  =  24.0 
NPERF  =  19 

D  =  5.0*PD  +  4.0*W1  +  2.0*WO 

^  %  4r  %  He  %  *  4t  *  *  4i  4f  *  *  *  *  4<  4(  *  *  *  4<  4)  Hi  %  4(  *  4t  4i  ’ll  4c  >1^  *  41 4t  4i 

C******************  CALCULATIONS  FOR  CODES  7,8,10  ********************* 
c*********************************************************************** 
1160  CONTINUE 
WW  =  WI  +  PD 
WW2  =  WW**2 
PRFD  =  PD  +  U 
PRFD2  =  PRFD**2 
GRL  =  AMAXl  (GL  -  U.  0.0) 

E  =  0.0 

THETA  =  2.0*ACOS  (AMINl  (WW/PRFD,  1.0)) 

ALPHA  =  ACOS  (AMINl  ((2.0*WO  +  PD  -  U)/PRFD.  1.0)) 

IF  (U  .LT.  WO)  E  =  0.25*PI*((2.0*WO  +  PD  -  U)**2  -  PRFD2) 

IF  (THETA  .GE.  PI3)  GO  TO  1 170 

E  =  E  -h  SI*0.25*(WW2*RT  -  1.5*PRFD2*(SIN  (THETA)  PI3  -  THETA)) 

1170  CONTINUE 

IF  (ALPHA  .GE.  0.5*(PI  -  THETA))  GO  TO  1180 

E  =  E  +  SO*0.125*(2.0*(2.0*WO  +  PD  -  U)*(2.0*WW  -  PRFD*SIN  (ALPHA)) 

1  -  PRFD2*(SIN  (THETA)  +  PI  -  2.0* ALPHA  -  THETA)) 
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1180  CONTINUE 

IF  (2.0*WO  +  PD  .LT.  WI)  THEN 
WRITE  (*.  *)  •*FORMT*  BAD  HEX  PROP* 

PAUSE 
GOTO  1190 
END  IF 

VOLUNB  =  E*GRL 

(^4.*4<*4>*4.4i*****«4.*«4.*  JEST  TO  SEE  IF  GRAIN  CONSUMED  ******************** 
IF  (VOLUNB  .LE.  0.0)  THEN 
SFAREA  =  0.0 
VOLUNB  =  C.O 
GOTO  1190 
END  IF 

THE  SURFACE  A  REA 

PH  =  D/2.  -  WO  -  PD/2. 

IF  (U  .EQ.  0.0)  THEN 

SFAREA  =  2.*E  +  GRL*PH*6.  +  NPERF*PI*PD*GRL  +  PI*GRL*(2*WO  +  PD) 
GOTO  1190 
END  IF 

3EIVERING  yet*"*"*' 

IF  ((WO  .GT.  U)  .AND.  (WI  .GT.  U))  THEN 
SFAREA  =  2.*E  +  NPERF*'(PD  +  U)'»GRL*'PI  +  6.*'PH'* 

1  GRL  +  PI*'(2.*WO  +  PD  -  U)*'GRL 
GO  TO  1190 
END  IF 

NOW  SLIVERING  '•'X"<'*>*"*'*>*‘'*'*'*‘*4")"<'*'("*‘***’*‘**'l‘*>)"<'*‘*‘***t' 

SFAREA  =  2.*'E 

^Itt4<4>«4<«4i4i4r«*4i«*it(4<4<ix*4>4<*«  pJRST  THE  INNER  SLIVERS  ********************* 

IF  (THETA  .GE.  P13)  THEN 
GO  TO  1200 
ELSE 

SFAREA  =  SFAREA  +  1.5*'PRFD*'GRL*'(PI3  -  THETA)*'SI 
END  IF 

1200  CONTINUE 

QUTER  SLIVERS  &  CORNERS  ********************** 
Q<ll^,*^,*^,^,^^*^^***t‘<^*****  CORNERS  NOT  CONSUMED  ***************************'»> 
IF  (WO  .GT.  U)  THEN 

SFAREA  =  SFAREA  +  PI*'(PD  +  2.*WO  -  U  +  PRFD)'*'GRL 
E]^^D  IF 

OUTER  STIVERS*"*"*"*"*"*"*"*"*"*"*"*"*"*"*"*"*'*"*"*"*"*"*"*"*"*"*"*"*"*' 

IF  (ALPHA  .LT.  .5*(PI  -  THETA))  THEN 
SFAREA  =  SFAREA  +  (WW  -  PRFD^SIN  (ALPHA))*GRL*SO  + 

1  PRFD*GRL*(Pl/2.  -  ALPHA  -  THETA/2.)*'SO 
END  IF 

1190  CONTINUE 
RETURN 
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^  *  *  *  *  «  *  *  *  4i  4i  *  4i «  4i  4^  4rifr  itc  4i  1)1 4i  4t « It< « Iti  1||  *  *  « itcid  *  «  *  4i »  4i  *  I|<  4i  *  *  41 «  4c  *  4i  *  %  *  « IK  41  4<  4ci)>  *  4<  4> « I|<  >!•  Itc  *  % 

^4i4i4t4c4<4i4t4c4<4>4<4i4i4<4i4i4c4i4i  9*  19-PERF  GRAIN  * '•i *’*"l‘*<'*i’*"*"^ 

^  4c  4i  4c  4>  4<  4<  4<  4<  4i  4c  4c  4>  4i  4<  *  4i  4c  4i  4i  4<  4i  4>  4>  4c  4<  4<  4i  4>  4c  4c  *  4i  4c  4c  4c  4<  4<  4>  4c  4<  4t  4>  4t  4c  4i  4c  4>  4i  4i  4<  4c  4c  4i  4<  4>  4c  4i  4<  4<  4c  4c  4c  4<  4c  4c  4c  4' 4c  4c  4>  4< 

C***  This  part  calculates  the  conditions  before  the  grain  bums  ******** 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Id  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  <c  4c 

1070  CONTINUE 

D  =  5.0*PD  +  2.0*(WI  +  WM  +  WO) 

EO  =  PI*(D**2  -  19.0*PD**2)/4.0 

SO  =  PI*(D  +  19.0*PD)*GL  +  2.0*E0 

VO  =  E0*GL 

S19  (1,  1)  =  WI  +  P  D 

S19  (2,  1)  =  S19  (1.  1) 

S19  (3.  1)  =  S19  (1.  1) 

S19  (1,  2)  =  0.5*SQRT  (3.0*(WM  +  PD)**2  +  (WI  +  PD)**2) 

S19  (2,  2)  =  819(1,2) 

819(3,  2)  =  819(1,  1) 

819  (1,  3)  =  PD  +  0.5*(WI  +  WM) 

819  (2,  3)  =  819  (1,  2) 

819  (3,  3)  =  WM  +  PD 
819(1,4>  =  819(1,  3) 

819  (2,  4)  =  2.0*819  (1,  3) 

819  (3,  4)  =  819  (1,  3)*RT 

WEBC  =  AMINl  (WO,  WM,  WI.  819  (1.  3)  -  PD.  819  (1,  2)  -  PD,  GL) 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4  4  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  id  4c  4  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4  4c  4c  dc  4c  4c  4c  4  cd  4c  4c  4c  Id  4c  4c  4c 

C*44  This  part  does  the  calculations  for  the  burning  grain.  444444444444 
iP  144444444444444444444444444444444444444444444444444444444444444444444444 

GRL  =  AMAXl  (GL  -  U.  0.0) 

^44444444444444444444444444444444444444444444444444444444444444444444444 


OD  =  D  -  U 

PRFD  =  PD  +  U 

IF  (U  .GE.  WEBC)  GO  TO  1210 

E  =  0.25*PI*(OD**2  -  19.0*PRFD**2) 

8FAREA  =  PI*(OD  +  19.0*PRFD)*GRL  +  2.0*E 
FRCSFA  =  8FAREA/S0 
VOLUNB  =  E*GRL 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRNA'O 
RETURN 
1210  CONTINUE 
8UM8A  =  0.0 
8UMGV  =  0.0 
DO  1220  K  =  1.  2 

CALL  GENIS  (819  (1.  K).  PRFD.  GRL.  8A.  GV) 
8UM8A  =  8UM8A  +  6.0*SA 
SUMGV  =  8UMGV  +  6.0*GV 
1220  CONTINUE 

CALL  GENI8  (819  (1,  3),  PRFD,  GRL,  SA.  GV) 
8UM8A  =  SUMSA  +  12.0*SA 
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SUMGV  =  SUMGV  +  12.0*GV 

CALL  GENOS  (S19  (1,  4),  PRFD,  GRL,  .5*OD,  SA,  GV) 

SUMS  A  =  SUMS  A  +  12.0*SA 

SUMGV  =  SUMGV  +  12.0*GV 

SFAREA  =  SUMSA 

FRCSFA  =  SFAREA/SO 

VOLUNB  =  SUMGV 

VOLBRN  =  VO  -  VOLUNB 

FRCBRN  =  VOLBRN/VO 

RETURN 


cQDE  10:  ROUND-HEX  7-PERF  GRAIN 


1060  CONTINUE 
SO  =  6.0 


SI  =  6.0 
NPERF  =  7 

D  =  3.*PD  +  2*WI  +  2*WO 
GOTO  1160 

^*41 4i4>  4<**4'*4<4>****<t>  it<  4< 

(;;«**4i4.4.4i«4i*4i4.**4>4i4<«4<  CODE  IL  CORD  WITH  INHIBITED  ENDS  ****♦****■*'**•**** 

^  *  4.  ***  4iit>  1^  III  *  4i  4r  *  «*«!)>*««  4i  4<  *  <1*  i|>*  4>  4>  4>  *  4>  4>  ***«  4>  it<  >l<  s|>  4i  ******  lit  *  4ii*i  tr «  *4i « 


C  This  routine  will  only  calculate  the  surface  area  of  the  lateral  surfa 

Cces. 

C  It  will  not  calculate  the  surface  area  of  the  inhibited  ends.  ******** 

C****4i**************************************** ************************** 

1 100  CONTINUE 
SO  =  GL*PI*D 
VO  =  GL*PI*D*  *2/4.0 

C  ****  This  part  does  the  calculations  for  the  burning  grain 
OD  =  AMAXl  (D  -  U.  0.0) 

SFAREA  =  PI*OD*GL 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  GL*PI*OD**2/4.0 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
RETURN 

C********************************************* ************************** 

C**********  CODE  12:  RECTANGULAR  STRIP  GRAIN  WITH  INHIBITED  SIDES  ****** 

c*********************************************************************** 


C  This  routine  will  only  calculate  the  surface  area  of  the  two  burning  s 
Cides. 

C  It  will  not  calculate  the  surface  area  of  the  inhibited  sides. 

c*********************************************************************** 


1110  CONTINUE 
SO  =  2.0*GL*WI 


VO  =  GL*D*WI 


VOLMAO  =  (D  -  WI)*GL*WO 
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n n n  ^  nnn  nnnnn  nnnnn 


VOLMBO  =  WI*GL*WO 

^  4>  *  4r  *1^  «  *  «  *  «  *  *  *  4>  4>  *  4c  4<  4i  *  Ik  1)1 4< «  4r «  *  «  «  «  «  4<  >1- «  *  I|>  4"l>  4> « >)>  4<  4^  Ik  >*<  4c  Ik  *  4i  4^  *  4<  *  *  I)<  >t<  4<  *  «  %  * 

C  ***  This  part  does  the  calculations  for  the  burning  grain 
DS  =  AMAXl  (D  -  U.  0.0) 

SFAREA  =  2.0*GL*WI 
FRCSFA  =  SFAREA/SO 
VOLUNB  =  GL*DS*WI 
VOLBRN  =  VO  -  VOLUNB 
FRCBRN  =  VOLBRN/VO 
IF  (DS  .GE.  WI)  THEN 
VOLABR  =  VOLBRN 
VOLBBR  =  0. 

ELSE 

VOLABR  =  VOLMAO 
VOLBBR  =  VOLBRN  -  VOLABR 
END  IF 
RETURN 
END 

^  4i  4i  4: 4' 4i  4i  4c  4c  4i  4i  4<  4i  4<  4<  4c  k  4i  4i  4i  4i  4i  41 4i  k  4>  4i  4i  4<  4i  4i  4i  4<  4<  4i  4c  4i  4i  4i  4c  *  4>  4>  4i  4<  4c  4>  4>  4<  4<  4<  4<  4c  4c  4c  4i  k  4c  4c  4<  4c  Ik  4i  4i  4i  4<  4>  4c  4<  41 4> 

^kkkkk4ckkkkkkkkkkkkkkkkkkkkkk4ckkkkkkkkkkkkkkkkkkkk4kkkkkkkkkkkkkkkkkkkkk 


SUBROUTINE  *GENIS*;  calculate  surface  area  and  volume  for  a 
general  inner  sliver  of  a  burning  grain 
with  length  =  GRL  &  perforation  dia.  =  PRFD. 

SUBROUTINE  GENIS  (S.  PRFD.  GRL.  SURF.  VOL) 
DIMENSION  S  (3),  A  (4) 

DATA  PI2/1 .5707963/ 


**********  :  Store  angles  A1,A2.A3  and  area  of  triangle 
with  sides  S(1).S(2),S(3)  into  A(l)...A(4) 

A  (1)  =  ACOS  ((S  (2)**2  +  S  (3)**2  -  S  (1)**2)/(2.0*S  (2)*S  (3))) 

A  (2)  =  ACOS  ((S  (1)**2  +  S  (3)**2  -  S  (2)**2)/(2.0*S  (1)*S  (3))) 

A  (3)  =  ACOS  ((S  (1)**2  +  S  (2)**2  -  S  (3)**2)/(2.0*S  (1)*S  (2))) 

A  (4)  ==  0.5*S  (1)*S  (3)*SIN  (A  (2)) 


...check  for  error  condition:  find  if  triangle  acceptable... 


J  =  0 

DO  10001=  1,3 
IF  (A  (I)  .LT.  0.5*PI2)  J  =  J  +  1 
OOO  CONTINUE 

IF  (J  .GT,  1)  STOP  •  GENIS  ERROR’ 


succeeding  passes  until  burnout:  find  auxiliary  angles 
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TAU12  =  ACOS  (AMINl  (1.0,  S  (3)/PRFD)) 
TAU13  =  ACOS  (AMINl  (1.0.  S  (2)/PRFD)) 
TAU23  =  ACOS  (AMINl  (1.0,  S  (1)/PRFD)) 


..and  branch  to  25  if  sliver  fails  burnout  criteria.  If  not 
then  sliver  is  burned  and  go  to  30. 

IF  (TAU12  +  TAU13  +  TAU23  .LT.  PI2  .AND.  GRL  .GT.  0.0)  THEN 
GO  TO  1010 
ELSE 

GO  TO  1020 
END  IF 


sliver  not  burned  out:  determine  end  area,  volume  and  surface  area 
010  CONTINUE 

E  =  A  (4)  -  0.25*PRFD*(S  (1)*SIN  (TAU23)  +  S  (2)*S1N  (TAU13) 

1  +  S  (3)*SIN  (TAU12)  +  PRFD*(PI2  -  TAU12  -  TAU13  -  TAU23)) 

VOL  =  E*GRL 

SURF  =  2.0*E  +  GRL*PRFD*(PI2  -  TAU12  -  TAU13  •  TAU23) 
...and  RETURN 
RETURN 

sliver  is  burned  out:  rcluni  with  zero  volume  and  surface  area. 

020  CONTINUE 
VOL  =  0.0 
SURF  »  0.0 
RETURN 
END 


SUBROUTINE  "GENOS"  :  Calculates  surface  area  and  volume  for  a 
genera)  outer  sliver  of  a  burning  grain 
with  length  s  GRL.  radius  =  RAD.  and 
perforation  diameter  s  PRFD 

SUBROUTINE  GENOS  (S.  PRFD.  GRL.  RAD.  SURF.  VOL) 
DIMENSION  S  (3).  A  (4) 

"*****•*•*•*  Store  angles  A1.A2.A3  and  area  of  triangle 
with  sides  S(1).S(2),S(3)  into  A(l)  ...A(4) 
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A  (1)  =  ACOS  ((S  (2)**2  +  S  (3)**2  -  S  (!)**2)/(2.0*S  (2)*S  (3))) 

A  (2)  =  ACOS  ((S  (1)**2  +  S  (3)**2  -  S  (2)**2)/(2.0*S  (1)*S  (3))) 

A  (3)  =  ACOS  ((S  (1)**2  +  S  (2)**2  -  S  (3)**2)/(2.0*S  (1)*S  (2))) 

A  (4)  =  0.5*S  (1)*S  (3)*SIN  (A  (2)) 


succeeding  passes  until  burnout;  determine  auxiliary  angles 

TAUl  =  ACOS  (AMINl  (1.,  (S  (2)**2  +  RAD**2  -  0.25* 

1  PRFD**2)/(2.*S  (2)*RAD))) 

TAU2  =  ACOS  (AMINl  (1..  (S  (3)**2  +  RAD**2  -  0.25* 

1  PRFD**2)/(2.*S  (3)*RAD))) 

TAU3  =  ACOS  (AMAXl  (  -  1.0,  (S  (2)**2  -  RAD**2  +  0.25* 
1  PRFD**2y(S  (2)*PRFD))) 

TAU4  =  ACOS  (AMAXl  (  -  1.0,  (S  (3)**2  -  RAD**2  +  0.25* 
1  PRFD**2)/(S  (3)*PRFD))) 

SIG  =  ACOS  (AMINl  (1.0,  S  (1)/PRFD)) 


...then  check  error  conditions... 

IF  (TAU3  .LT.  A  (3)  .OR.  TAU4  .LT.  A  (2))  STOP  *  *GENOS*  ERROR’ 


..IF  ok,  check  if  sliver  burned  out.  If  not  burned  out  go  to  25. 
If  burned  out  go  to  30. 

IF  (TAUl  +  TAU2  .LT.  A  (1)  .AND.  GRL  .GT.  0.0)  THEN 
GO  TO  1000 
ELSE 

GO  TO  1010 
END  IF 


sliver  not  burned  out:  determine  end  area,  volume  and  surface  area. 

)00  CONTINUE 

E  «  0.5*RAD*(S  (2)*SIN  (TAUl)  +  RAD*(A  (1)  -  TAUl  -  TAU2) 

1  +  S  (3)*SIN  (TAU2))  •  A  (4) .  0.25*PRFD*(S  (1)*S1N  (SIG) 

2  0.5*PRFD*(TAU3  +  TAU4  -  2.0*SIG  -  A  (2)  -  A  (3))) 

VOL  «  E*GRL 

SURF  «  2.0*E  +  GRL*(RAD*(A  (1)  -  TAUl  •  TAU2)  +  0.5*PRFD*(TAU3 
1  +  TAU4 . 2.0*S1G  -  A  (2)  -  A  (3))) 

.and  RETURN. 

RETURN 
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C  sliver  is  burned  out:  return  with  zero  volume  and  surface  area. 

C 

1010  CONTINUE 
VOL  =  0.0 
SURF  =  0.0 
RETURN 
END 

^  «  4i  4i  *  4< «  *  *  «  *  *  *  » «  4i «  «  *  «  *  *  «  *  «  «  4r «  « *  4>  41  *  *  *  4i  *  41%  4; »  41 4ii|i  *  4i  4:  *  4r  4C4I  Hi  %  Hi  iti  4c  4ri|i  *  *  4. 4i  It. « 


SUBROUTINE  IGRALS  (XS.  J.  DB) 

^%%%4<%%4i4i%4i4i%4>4i4i%4i*4i%4>%4>*4i*4i4r%%4<4i4i4>%4>4i%4i4t4>4>4:4>%4<4i4>4c4i4i4<4i4<4i4>4c4>4>4<4<4>4<4<4c4c4>4i4i4i4i 

C  Version  3.0,  January  1992 
C 

C  This  subroutine  is  used  to  compute  the  integrals  from  beginning  of 
C  the  layer  to  the  depth  burned. 

C 

^%%%%4>%4>%4>%%4i%%%4>%4i4<4<%4i4<4i4>4i4<4>%4i4>%4>4i4i4<4i4t4>4i4i%4>%%4c4i4>4>4i4>4c4>4>4<4c%4>4i4>%4<4'4<4<4>4>4c4i4i4i 

COMMON  /ARRAYS/  A3  (100),  PX  (11.  15.  5) 

ITYPE  =  INT  (A3  (45)  +  .5) 

NL  =  INT  (A3  (4)  +  .5) 

DO  1000  I  =  2.  11 
PX  (1.  J.  5)  =  0.0 
1000  CONTINUE 

^%«4'4i4<%4'*4i*%%%*4<%*%%*%*%4>4i%%4i*%4<4i%%%%4>%%%%%%%%%*4>%4>4>%%%4<4>4i4>4i4>4i%%4>%4»t'%%** 

C******  first  the  length  of  the  INTERVAL  FOR  PROPERTY  IS  DETERMINED  **** 

^%4i%%4i4t»«%%*««4>%%4i*%4i»4<%4>%%%%«4i%*4i%*%%4'%%%4>%4i%%4'%4<%%%4'%%4>4<4i%4>4i4>4i4>%%*4i4>4>% 

IF  (J  .EQ.  NL)  THEN 
XMAX  =  A3  (1) 

ELSE 

XMAX  =  PX  (1.  J  +  1.  1) 

END  IF 

XDELl  =  XMAX  -  XS 

^%4i«%4i*%%4i%%%%%%4>%4i%4i*4>%4>%%4r*4c%4>4i4i4>4>4'4i4<%4c4i4>4i%%%4i%4>4i4>4c4c4i4'4>4>4'4>%%4'%4i4c4<4c4'4'%% 

^%4>4r4i%4r*%%%%4i4c4'4>4c%4c%4i4>%  ALWAYS  300  SUBDIVISIONS  *'<"********************** 

^%4r%4c4>4i%%4i4i%4>%%%4c%%4i%4i4i%4'44'4>%%%%4>4i%%%4>4i%4>%%4i4i4>4i4<4>4i4i4i4i%%%%4i%4>%4i4>4i4c4>4i4c%4i4i4> 

XDEL  =  DB  -  XS 
XSTEP  =  XDEL/300. 

DO  1010  I  =  1.  301 
XI  =  XS  +  (I  ■  1)*XSTEP 

Q%%%%%%%4i4i4t%%%**4>«**%4i%*4i4'4i%%4i%4i4>4i%%4i%4>4'4'4>4>4>4<4>4>4i4>4<4i4>4i4i4i4>4<%%4>%*%%4>4i4>4c4>4i4i4i 

CALL  FORMT  (ITYPE.  ASURF,  VOLUNB.  XI) 

Q4i%4i%%4i4'4i%4i%4>4>%%4i%4i4i%%%%4>%*%%4>4i%%4i4i%%4i%%%%%4c4>4i4>4c4i4i4i4i4i4>4i4i4i4'%4>*%%%4c4i4i%4i4i%% 

DO  1020  K  =  2.  11 
PDEL  =  PX  (K.  J.  2)  -  PX  (K.  J.  1) 

04i%%%%4i%*%4i%%%4i4r4i4i4>4i%*4i4i%%%4i4i4i%4<4>4>%4t4i4i4i*4>4r4i4i4i4i%4i%*4>4<4>4i4'4>4i4i4i4i%4i4>%4>%%%4<4>*4> 

^4r4i%4>%4>%4>**4c%%*%4i4.*%4>4<4<  INTEGRATION  IS  PERFORMED  *********************** 
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Q  *1)1 « III « it<  III  4i  *  4>  *  41 4>  *  III  *  *  <1 1!- «■  4>  <•  *  *  *  *  4i  4f  *  *  *  «  *  4> « itiiti  itiili  i|ii|c «  « i|ii|r  41 « i(<  iti «  *  i|>  4c  :tc «  *  *  i(i «  %  111  >)•  4<  >l<  >•>  * 

FCN  =  ((PDEL/XDEL1)*(XI  -  XS)  +  PX  (K.  J.  1))*ASURF 
IF  (a  .EQ.  1)  .OR.  a  EQ.  301))  THEN 
PX  (K.  J.  5)  =  PX  (K,  J.  5)  +  FCN 
ELSE 

PX  (X.  J.  5)  =  PX  (K,  J,  5)  +  2.*FCN 
END  IF 

1020  CONTINUE 
1010  CONTINUE 

Q  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4t  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  4i  4i  4i  4i  4i  4, 4i  4i  4i  4i  4i  4i  4i  4, 4i  4i  4, 4, 4i  4i  4i  4i  4i 


(34i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i  NOW  THE  INTEGRAL  VALUE  IS  DETERMINED  **t'************ 


Q  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  *  4i  *  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4c  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4>  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  III  4i  4i  4i  4<  4i  4i  41 4i  4i 


DO  1030  K  =  2,  11 

PX  (K.  J,  5)  =  PX  (K,  J.  5)*(XDEL/600.) 
1030  CONTINUE 
1040  CONTINUE 


RETURN 


END 
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APPENDIX  L. 

LISTING  -  PROGRAM  MKOUT.FOR 


335 


Intentionally  left  blank. 
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PROGRAM  MKOUT 


^  4i  4i  4>  >)■  *  <l>  t")!  *  4<  *  *  <li  *  *  I|<  <■  >t<  <t>  4i  <1 4>  *  *  *  *  4>  *  I|i  4c  *  4ri|<  *  «  *1 « I|i «  «  *  *  «  *  4i  4i  %  <*■  <*■ «  4>  Di  4<  4<  *  i|i  *  4<  4< «  «  4^  % 


C  Version:  3.0,  January  1992;  Last  Modifled  12/31/91 
C  cleanup 

C 


C  Written  by:  William  Oberle,  U.S.  Army  Research  Laboratory 
C 

^  4i  4c  4>  4c  ck  4c  4<  4c  4i  4<  4c  4c  4i  4c  4i  4c  4i  4i  4i  4i  4c  4c  4i  4»4  4c  4c  4c  4c  4c  4i  4i  4i «  *  4i  4c  4>  4i  4c  4c  4c  4c  4c  4i  4i  4c  4c  4c  <4  4<  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4<  4>  4c  4c  4>  4< 


CHARACTER*20  FNAME,  A1  (20).  A2  (6)*80.  ITEMP* 

1  60,  LINE*132.  WORDl*9. 

2  WORD2*10.  CHART*2.  FGRF*20.  NAMY,  APL  (30.  60)*1,  A*l.  NAMEl 
DIMENSION  A3  (100),  FRAT  (1024,  3),  XLFRAT  (1024,  3),  P  (11,  15,  5) 
DIMENSION  TAL  (15.  2) 

DATA  APL/1800*’  7 
CALL  CLEAR 


^  4c  4c  c»  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  c»  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


(^4c4c4c4c4c4c4>4c4>4c4c4c4c4c4c4c  Reading  the  information  file  *****4c4cc44c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c 
^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  41 4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c 


WRITE  (*.  6000) 

6000  FORMAT(///.10X.'Enter  the  file  name.’) 

READ  (*,  5000)  FNAME 
5000  FORMAT(A20) 

NAMEl  =  FNAME 
1000  CONTINUE 
DO  1010  I*  1.  17 
A  =  NAMEl  a:I) 

IF  (A  ,EQ.  ’.’)  THEN 
CALL  CLEAR 


WRITE  (*,  '••)  ’The  file  name  entered  has  an  extension  which  is’ 

WRITE  (*,  *)  ’not  allowed.  Please  enter  a  new  name  without  ’ 

WRITE  (*,  *)  ’an  extension.’ 

READ  (*.  5000)  NAMEl 
GO  TO  1000 
END  IF 

IF  (A  .EQ.  ’  ’)  THEN 
NAMEl  (1:1  +  3)  =  ’.inf 
GO  TO  1020 
END  IF 

1010  CONTINUE 
1020  CONTINUE 
FNAME  =  NAMEl 
OPEN  (UNIT  =  9,  FILE  =  FNAME) 

REWIND  (UNIT  =  9) 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  c»  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck 
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DO  10301  =  1.6 
READ  (9.  5010)  A2  0) 

1030  CONTINUE 
5010  FORMAT(A80) 

DO  10401  =  1,20 
READ  (9,  5000)  A1  G) 

1040  CONTINUE 
DO  1050  I  =  1,  100 
READ  (9,  ♦)  A3  G) 

1050  CONTINUE 
DO  10601  =  1,  11 
DO  1070  J  =  1,  15 
DO  1080  K  =  1.  5 
READ  (9.  *)  P  G.  J.  K) 

1080  CONTINUE 
1070  CONTINUE 
1060  CONTINUE 
CLOSE  GJNIT  =  9) 

^  «  «  *  *  *  *  *  «  *  *  *  *141  *  *  «  41 4<  i|<  *  *  4<  *  4<  *  *  »  !«<  4i  Hi  4>  III «  4>  *  «  *  *  *  *  >|i  1*1  *  *  %  *  *  *  *  *  *  *  III  4. 1)1 

0414.41414141*414141*414.41  INFORMATION  ABOUT  THE  FIRING  IS  OBTAINED  *************** 

0******************iii**************************************************** 

CALL  CLEAR 
WRITE  (*.  *)  ’  ’ 

WRITE  (*,  *)  ’  ’ 

WRITE  (*,  *)  ’  Enter  the  date  of  the  closed  chamber  firing.’ 

READ  (*,  5000)  A1  (20) 

WRITE  (*,  *)  ’Enter  any  comments  concerning  the  closed  chamber’ 

WRITE  (*,  *)  ’firing.  Three  lines  are  required  and  the  lines’ 

WRITE  "■)  ’may  be  blank.  Include  operators.’ 

READ  (*,  5010)  A2  (1) 

READ  (*,  5010)  A2  (2) 

READ  (*.  5010)  A2  (3) 

CALL  CLEAR 

WRITE  (*,  *)  ’Enter  any  comments  concerning  the  data  reduction.’ 

WRITE  (*,  *)  ’Three  lines  are  required  and  the  lines  may  be  blank.’ 

WRITE  (*,  *)  ’Include  date  and  operator.’ 

READ  (*,  5010)  A2  (4) 

READ  (*,  5010)  A2  (5) 

READ  (*,  5010)  A2  (6) 

0*********************************************************4.*4,i|i*4,4.4.***4,4,* 

0**************  inpoRMATION  is  rewritten  *******<■******'•"•'**********•*** 

0************************************************************I|.********4,* 

OPEN  (UNIT  =  7,  FILE  =  FNAME) 

REWIND  (UNIT  =  7) 

DO  10901*  1.6 
WRITE  (7.  5010)  A2  G) 

1090  CONTINUE 


DO  11001=  1,20 
WRITE  (7.  5000)  A1  G) 

1100  CONTINUE 
DO  11101=  1.  100 
WRITE  (7.  *)  A3  (I) 

11 10  CONTINUE 
DO  11201=  1.  11 
DO  1  30  J=  1,  15 
DO  1140  K=  1.5 
WRITE  (7.  *)  P  (I,  J,  K) 
1140  CONTINUE 
1130  CONTINUE 
1120  CONTINUE 
CLOSE  (UNIT  =  7) 


^  41*  Hi  *  *  *  *  *  «  «  *  *  4i  I|i :»  *  *  «  *  *  4t «  4>  4> «  *  4<  *  *  *  *  *  4>  *  4r  *  «  *  «  4. «  4r  «>  41 «  «  *  «  «  *  *  A*  *  Ikilc  Itci4ii!i  4c  * 


^4i4c4c4c4c4c4i4c4>4i4<*4i***4c  OUTPUT  FORM  PROGRAM  ******************************** 


C4.*4.**  THIS  PROGRAM  WILL  OUTPUT  THE  INFORMATION  FROM  A  BRLCB  ********** 

^4c4c4c4c4t4<4c4c4c*4c4i4c4c4<4>4c4c4c4c4c4c4c4c4i4c4i  ANALYSIS.  ******************************** 


^  4c  4>  4<  4t  4>  4c  4c  4c  4c  4<  4>  4>  4i «  4>  4>  4<  4i  4<  4c  4c  4c  4c  4c  4c  4i  4t  4i  4r  4i  4i  4c  4i  4' 4c  4<  4>  *  4c  4>  4<  4<  4<  4c  4c  4>  4c  4c  4' 4c  4>  4>  4>  4c  *  4<  4<  4<  4<  4i  4c  4c  4>  4i  4i  4c  4>  4>  4<  4c 


CALL  CLE  AR 
NAMY  =  A1  (10) 

WRITE  (*.  6010) 

6010  FORMAT(///,10X,*The  program  will  produce  both  hard  copy  to’, 
l/,10X,’the  printer  and  a  disk  copy  of  the  output.  Select  the’, 

2/,  1  OX. ’option.’, 

3//,15X,’l.  Hard  copy  to  printer  only.’, 

4/.15X,’2.  Disk  copy  only.’, 

5/,15X,’3.  Both  disk  and  hard  copy.’, 

6//,  1  OX, ’Enter  your  choice  (1-3).’) 

READ  (*,  *)  lOUTai 

IF  ((lOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
FGRF=  ’LPTl’ 


WRITE  (*,  6020)  FGRF 

6020  FORMAT(//,10X,’The  current  printer  is:  ’,A20, 

l/,10X,’l,  Accept  Current  Printer’ y,10X,’2.  Enter  new  choice’^ 
2/,15X,’Enter  choice’ y) 

READ  (*.  *)  IPRTE 
IF  (IPRTE  .EQ.  2)  THEN 
WRITE  (*,  *)  ’Enter  new  printer  name.’ 

READ  (♦,  5020)  FGRF 
5020  FORMAT(A20) 

END  IF 

OPEN  (UNIT  =  7,  FILE  =  FGRF) 

END  IF 

IF  GOUTCH  .NE.  1)  THEN 
WRITE  (•.  6030)  A1  (10) 

6030  FORMAT(//,10X,’Enter  the  file  name  for  the  output.’, 
1/,10X,’WARNING  THIS  FILE  CANNOT  BE  NAMED:’/, 
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2A15X,A20) 

READ  (•,  5000)  FGRF 
NAMY  =  FGRF 

OPEN  (UNIT  =  2.  FILE  =  FGRF) 

REWIND  (UNIT  =  2) 

END  IF 

^  41  *  4c «  4i  iji  41 « itr  4>  111  4t  *  «  «  41 «  «  *  4i  *  *  4i «  4iili  4i  *  4i  *  4>  4i «  4i  4i «  *  «!<■ «  *  *  *  itiili  4iit>  it>  it<  41  *  4>  *  *  «  «  *  «  *  4f «  «  4i 

^4>4i4>4>4<>l<4>4i4>****4>4>*4<4i4i4>*  OPENING  GRAPHICS  RLE  ************************** 

^  4>  4i  4c  4>  4>  4<  *  4<  4i  4' 4i  4>  4<  4>  4c  4i  4<  41 4>  4>  4<  4i  Ik  4i  4i  4i  4i  4i  4i  4i  1^  4>  4i  4>  4>  4c  4<  4i  4i  4c  4<  4>  4>  4i  4c  4i  4i  4i  4>  4<  4c  4t  *  4i  4>  4<  4i  4i  4c  4<  4i  4c  4i  4<  4<  4<  4i  4i  4i  4i 

OPEN  (UNIT  =  9.  RLE  =  A1  (17)) 

REWIND  (UNIT  =  9) 

^  4c  4c  4c  4i  4c  4i  4c  4c  4c  4c  4c  4c  4i  4i  4i  4>  *  4c  4i  4c  4>  4c  4i  4<  4>  4c  4<  4>  k  4c  *  4i »  *  4i  4i  4c  4i  4i  4i  4i  4i  4c  4c  4c  4i  4c  4i  4c  4i  4>  4i  4>  4i  41 4c  4c  4i  4c  4c  4i  4c  4>  4c  4c  4i  4c  4c  4c  4c 
^4c4c4c4c4c4c4cck4c4c*4i4c4c4c4c4c4c  HEADINGS  ARE  PRINTED  4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4c4i 
^4i  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4: 4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  ck  4c  4c  4c  4c  4c 

ITYPE  =  INT  (A3  (2)  +  .5) 

^  4c  4c  Ik  4c  4c  4c  4c  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  ck  4c  4c  4c  4c  k  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4>  4c  4c  4c  41 4c  4c  4c  4c  4c 

Q**:t.*************  loading  array  TAL()  for  summary  OUTPUT  4cik4c4cikck4c4c4c4c4c4c4c4c4c 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4i  4>  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4i  4' 4c  4c  4c  4c  4<  4c  4<  4<  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c 

IF  (aTYPE  .NE.  2)  .AND.  (ITYPE  .NE.  3))  THEN 
TAL  (1,  1)  =  20. 

TAL  (2,  1)  =  72. 

TAL  (3.  1)  =  100. 

TAL  (4,  1)  =  140. 

TAL  (5.  1)  =  200. 

TAL  (6.  1)  =  240. 

TAL  (7.  1)  =  300. 

TAL  (8.  1)  =  340. 

TAL  (9.  1)  =  400. 

TAL  (10.  1)  =  440. 

TAL  (11,  1)  =  500. 

TAL  (12.  1)  =  540. 

TAL  (13,  1)  =  600. 

TAL  (14,  1)  =  640. 

TAL  (15,  1)  =  700. 

END  IF 

Q  4c  4c  4c  4c  ck  4c  4c  4c  4c  *  4c  4c  Ik  Ik  >k  Ik  4c  k  Ik  k  ck  4c  4c  4c  4c  ck  4c  Ik  41  k  4c  4c  4c  4c  Ik  4c  ck  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  4c  4c  ck  4c  Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c 

^kkkkkkkkkkkkkkkkkkkkkk  THE  HEADINGS  ******************************* 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


IF  (ITYPE  .EQ.  1)  THEN 

IF  (aOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6040) 

6040  FORMAT(32X,’BURNING  RATE  ANALYSISV,37X,’BRLCB  V3.0’. 

I  /.22X, ’ADVANCED  BALLISTIC  CONCEPTS  BRANCH  -  BRVJ//) 
END  IF 

IF  (aOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6040) 

END  IF 
END  IF 
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IF  (TTYPE  .EQ.  2)  THEN 

IF  (OOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6050) 

6050  FORMAT(32X,’PRESSURE-TIME  GENERATIONV.37X,’BRLCB  V3.0’, 

1  /,22X, ’ADVANCED  BALLISTIC  CONCEPTS  BRANCH  -  BRVJ/d 

END  IF 

IF  (OOUTCH  .EQ.  2)  OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6050) 

END  IF 
END  IF 

IF  OTYPE  .EQ.  3)  THEN 

IF  (OOUTCH  .EQ.  i)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6060) 

6060  FORMAT(32X,’SU’RFACE  AREA  ANALYSIS’y.37X,’BRLCB  V3.0’, 

1  /.22X, ’ADVANCED  BALLISTIC  CONCEPTS  BRANCH  -  ERL' J/f) 

END  IF 

IF  (OOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6060) 

END  IF 
END  IF 

IF  (ITYPE  .EQ.  4)  THEN 

IF  (OOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6070) 

161  FORMAT(25X. ’INTERRUPTED  BURNER  ANALYSIS’y,37X.’BRLCB  V3 
1.0’/22X, ’ADVANCED  BALLISTIC  CONCEPTS  BRANCH  -  BRV  J/f) 

END  IF 

IF  (OOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6070) 

END  IF 
END  IF 

IF  (ITYPE  .EQ.  5)  THEN 

IF  (OOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6080) 

6080  FORMAT(32X,’ETC  BURN  RATE  ANALYSIS’y.37X.’BRLCB  V3.0’. 

1  /,22X.’ADVANCED  BALLISTIC  CONCEPTS  BRANCH  -  BRL’,///) 

END  IF 

IF  (OOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6080) 

END  IF 
END  IF 

OUTPUT  IS  NOW  PRINTED  ************************’l' 

^  «  *  *  *  *  4n|>  *  Hull  m  *  4i  *  *  *  «  *  *  *  *  *  4  *  *  Ik  «  Hiiti  *  *  Ik  *  *  4<  *  4^  4>  *  *  *  *  *  *  4iiti  Hi*  *41 *  Ik  *  *  *  *  *  4i  4>  Ki*  4<  *  *  4i 

IF  (OOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6090)  A1  (1).  A1  (2) 

6090  FORMAT(’  Project :  ’.A20.’  Requested  by  :  ’,A20) 

WRITE  (7.  6100)  A1  (4),  A1  (3) 

6100  FORMAT(’  Inf  File:  ’..A20.’  Created  From  .MAS  File  :  ’.A20) 
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WRITE  (7,  6110)  A1  (5).  A1  (10) 

6110  FORMATC  P/T  File:  ’,A20.’  Calculation  Output  File:  ’,A20) 
WRITE  (7.  6120)  A1  (14).  A1  (17) 

6120  FORMAT(‘  Smoothed:  ’,A20,’  Graphics  File  :  ’.A20) 
lOPTT  =  INT  (A3  (2)  +  .5) 

IF  (lOPTT  .EQ.  5)  THEN 
WRITE  (7,  6130)  A1  (19) 

6130  FORMATC  EE  File:  ’.A20) 

END  IF 

WRITE  (7,  6140)  A 1  (20) 

6140  FORMATC  Fired  on:  •.A20) 

IF  (A2  (1)  .NE.  *  ’)  THEN 
WRITE  (7.  *)  ’FIRING  REMARKS:’ 

WRITE  (7.  6150)  A2  (1) 

6150  FORMAT(’  ’.A80) 

END  IF 

IF  (A2  (2)  .NE.  ’  ’)  WRITE  (7.  6150)  A2  (2) 

IF  (A2  (3)  .NE.  ’  ’)  WRITE  (7.  6150)  A2  (3) 

IF  (A2  (4)  .NE.  ’  ’)  THEN 
WRITE  (7,  *)  ’REDUCTION  REMARKS:’ 

WRITE  (7.  6150)  A2  (4) 

END  IF 

IF  (A2  (5)  .NE.  ’  ■)  WRITE  (7,  6150)  A2  (5) 

IF  (A2  (6)  .NE.  ’  ’)  WRITE  (7.  6150)  A2  (6) 

END  IF 

IF  ((lOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6090)  A1  (1),  A1  (2) 

WRITE  (2.  6100)  A1  (4).  A1  (3) 

WRITE  (2.  6110)  A1  (5).  A1  (10) 

WRITE  (2.  6120)  A1  (14).  A1  (17) 
lOPTT  =  INT  (A3  (2)  +  .5) 

IF  (lOPTT  .EQ.  5)  THEN 
WRITE  (2.  6130)  A1  (19) 

END  IF 

WRITE  (2.  6140)  A1  (20) 

IF  (A2  (1)  .NE.  ’  ’)  THEN 
WRITE  (2,  *)  ’FIRING  REMARKS:’ 

WRITE  (2,  6150)  A2  (1) 

END  IF 

IF  (A2  (2)  .NE.  ’  ’)  WRITE  (2.  6150)  A2  (2) 

IF  (A2  (3)  .NE.  ’  ’)  WRITE  (2.  6150)  A2  (3) 

IF  (A2  (4)  .NE.  ’  ’)  THEN 

WRITE  (2,  *)  ’REDUCTION  REMARKS:’ 

WRITE  (2.  6150)  A2  (4) 

END  IF 

IF  (A2  (5)  .NE.  ’  ’)  WRITE  (2.  6150)  A2  (5) 

IF  (A2  (6)  .NE.  ’  ’)  WP.ITE  (2.  6150)  A2  (6) 

END  IF 
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Q  41 4i  <1 4)  1)1 4i  it<  4i  *  *  «  *  4ii|i «  *  «*  *  *  *  *  4iitii|ii<i  4i  III  It!  «•  *  «>  «i  ilii^  4i  *  *  Hi  *  4>  *  *  *  >•>  *  1)1  *  *  4t «  *  4<  + 1)1  %  *  *  *  *  « III  <*<  *  <l>  4>  *  « 

C***********  Igniter  Information  is  printed  next  ********************** 

Q^i^|l*:^ltl^l^l^ltl0l^l^lJ^^t|i^i^i***4■**************Dl********************************** 

IF  (aOUTCH  .EQ.  1)  .OR.  GOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6160) 

6160  FORMAT^,’  ’^OX, ’IGNITER  INFORMATION’) 

WRITE  (7,  6170)  A1  (11).  A1  (12) 

6170  FORMAT(’  The  IgnUer  Used  Is  :  ’.A20.’  Lot:  ’.A20) 

WRITE  (7,  6180)  A1  (13) 

6180  FORMAT(’  The  Source  For  The  Igniter  Is:  ',A20y) 

WRITE  (7,  *)  ’  IGNITER  THERMOCHEMICAL  PROPERTIES’ 

WRITE  (7,  6190)  A3  (13).  A3  (16) 

6190  FORMAT(’  Impetus  (J/g)  :’.F10.1.’  Molecular  Weight  :’, 

1F10.5) 

WRITE  (7.  6200)  A3  (14).  A3  (17) 

6200  FORMAT(’ Flame  Temperature  (K): ’.FI 0.1.’ Covolume  (cc/g)  :’. 

1F10.5) 

WRITE  (7.  6210)  A3  (15).  A3  (18) 

6210  FORMAT(’  Density  (g/cc)  :’.F10.5.’  Gamma  :’. 

1F10.5) 

END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6160) 

WRITE  (2.  6170)  A1  (11).  A1  (12) 

WRITE  (2,  6180)  A1  (13) 

WRITE  (2.  *)  ’  IGNITER  THERMOCHEMICAL  PROPERTIES:’ 

WRITE  (2.  6190)  A3  (13).  A3  (16) 

WRITE  (2,  6200)  A3  (14).  A3  (17) 

WRITE  (2,  6210)  A3  (15).  A3  (18) 

END  IF 


Q  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4<  4i  4i  4i  4i  4>  4i  4i  4i  4i  *  4i  4i  4i  *i  4i  4i «  4i  <1 4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4i  li 


Q4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i4i  PROPELLANT  INFORMATION  ***************************** 


Q^,^i*^l^i^,0^l%**^•*^i0**l^*^l^,^,^i^l**^>***^i^i4•************************************* 


IF  (GOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6220) 

6220  FORMAT(/.20X.’PROPELLANT  INFORMATION’) 

WRITE  (7.  6230)  A1  (6).  A1  (7) 

6230  FORMAT(’  The  Propellant  Used  Is  :  ’.A20.’  Lot:  ’.A20) 
WRITE  (7.  6240)  A1  (8) 

6240  FORMAT(’  The  Source  For  The  Propellant  Is:  ’,A20) 

WRITE  (7,  6250) 

6250  FORMAT(’  ’) 

WRITE  (7.  *)  ’  Propellant  Thermochcmical  Properties:  Following’ 
WRITE  (7.  •)  ’  Sheets  of  Output’ 

END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6220) 

WRITE  (2.  6230)  A1  (6),  A1  (7) 
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WRITE  (2,  6240)  A1  (8) 

WRITE  (2.  6250) 

WRITE  (2,  •)  ’  Propellant  Thermochcmical  Properties:  Following’ 
WRITE  (2,  *)  ’  Sheets  of  Output’ 


END  IF 

^  *  *  *  *  «  4i  III  *  iX  *  *  *  «  *  «  *  *  4>  it>  *  «  4<  *  4>  *  «  *41  *  4t «  «  «  «<  If  «  %  «  *  m  >»  *  *  *  *  #>*' *  «  «  4rit<  *  *  4:  If  4i  *  *  Hiiti  4<  4<  >•>  * 

^4>4i4i4i4i4i4i4i4i*4i4i4i4i4i4<4>  OUTPUT  OF  GRAIN  GEOMETRY  ’•"•"***********•********♦'*"•'** 

^  4i  41 4i  4>  4i  4i  4i  *  *  *  4i  4>  4i  4|  4i  4: 41 4i  4|  4|  4i  4i  4i  4i  4>  4i  41 41 4i  4i  4i  4i  4i  41 4i  4<  4i  4i  4i  4>  4i  4i  4>  If  4I  w  *  4i  4i  4i  4i  If  4i  41 4i  4i  4I  f  4<  4i  4>  4i  41 4i  4i  4i  41 4i  4|  4I 


IF  (OOUTCH  .EQ.  1)  .OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6260) 

6260  FORM AT(/,20X, ’PROPELLANT  GRAIN  GEOMETRY’) 

WRITE  (7,  6270)  A1  (9) 

6270  FORMAT(/.’  Grain  Type:’.A20) 

ICODEP  =  INT  (A3  (45)  +  .5) 

IF  (aCODEP  .EQ.  11)  .OR.  (ICODEP  .EQ.  13))  ICODEP  =  2 
IF  (ICODEP  .EQ.  12)  ICODEP  =  3 
8000  FORMAT(’  ’.lOX, ’Length  —  (cm.):’.F10.6) 

8010  FORMAT(’  ’.lOX.’Outer  Diam.(cm.):’,F10.6) 

8020  FORMAT(’  ’.lOX.’Width  — -  (cm.):’.F10.6) 

8030  FORMAT(’  ’,1  OX, ’Thickness  (cm.):’.F10.6) 

8040  FORMAT(’  '.lOX.’Perf  Diam.  (cm.):’4^10.6) 

8050  FORMAT(’  ’.lOX.’Slot  Width  (cm.):’.F10.6) 

8060  FORMATC  ’.lOX.’Inner  Web  (cm.):’.F10.6) 

8070  FORMAT(’  ’.lOX, ’Middle  Web  (cm.):’.F10.6) 

8080  FORMATC  ’.lOX.’Outer  Web  (cm.):’.F10.6) 

^  4i  *  *  4i  4i  4i  4i  4i  4i  *  4i  *  41*  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  If  4i  4i  If  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  If  4i  4i  If  If  4t  w  4i  4i  4i  4i  *  4i  4i  4i  4i  If 


Q********* ***************  3pherc  4iiii'^'i'*4ii*i4i4‘44i*************************** 

^******************************************14*************************** 


IF  (ICODEP  EQ.  1)  THEN 
WRITE  (7.  8010)  A3  (8) 
GOTO  1150 
END  IF 


^****************************************************************4.***** 


^***************  Remaining  grains  ali  tKed  length.  4i4i4***4i******4i**4i*** 
^*********************************************** *********************** 

WRITE  (7.  8000)  A3  (7) 

^********************************************************************** 


^***************  ^ext  the  rectangular  strip  is  done  •4i4i****4*4**4'****** 
^********************************************************************** 
IF  (ICODEP  .EQ.  3)  THEN 
WRITE  (7,  8020)  A3  (8) 

WRITE  (7.  8030)  A3  (10) 

GOTO  1150 
END  IF 


^*************************************************************** ******* 
^***********  remaining  grains  all  need  a  diameter  *«i4i*4i*4i4i4i**4i****4 
^****************************************************** **************** 


WRITE  (7.  8010)  A3  (8) 
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^  *  III  4>  *  *  4<  <|c>t<  *  4> « Ik  *  >l> «  4t  41 41 4i  Hi  iti  4i «  *  «  *  **  Ik  »  *  4> «  4c  *  «  *  4c «  « ](i  >t<  >t<  >l<  #  *  »  4<  >t<  *  >l<  *  *  *  4<  *  4c  *  itciti  :•<  *  *  * 

(^^4c4c4i4i4c4.4<4c4<4<4i4<  Cord  nccds  only  a  length  and  width  ********************** 

C 4c  4i 4i  4i k 4c  Ik  Ik  4i Ik  4c  4c  4c  4i  4i  4i  Ik  4i 4c  4c  Ik  4i  4c  4c 4c  4c  4i  4i Ik 4i 4c Ik 4c  4c 4c  4iik  *  4i  4c Ik  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  41 4c  4c  4c  4c  4c  4i  4i  4i  4i  4c  4i  4c 4c  4i  k  4c  4c  4c 

IF  (ICODEP  .EQ.  3)  GO  TO  1150 

^  4c  4>  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4i  4c  4c  4c  4i  4c  4c  4c  4i  4i  4i  4i  4c  k  4c  4c  4c  4c  4i  4c  k  4c  4c  4c  4c  4c  4c  4c  4c  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  Ik  4c  Ik  4c  4c  4c  4c  4c  4c  4i  4c  4c  Ik  4c  4c  4c 

C*********  All  remaining  grains  need  perf  diameter  kkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


WRITE  (7.  8040)  A3  (9) 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk4ikk 

^kkkkkkkkkkkkkkkkkk  ^gxt  the  Slotted  tube  kkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

IF  (ICODEP  .EQ.  5)  THEN 
WRITE  (7.  8050)  A3  (11) 

GOTO  1150 
END  IF 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkkkkkkkk  remaining  grains  need  inner  web  kkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

WRITE  (7.  8060)  A3  (10) 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkkkkkkkkkkkk  i-perf  cylinder  is  finished  kkkkkkkkkkkkk4ckkkkkkkkkkkk 

Qkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

IF  (ICODEP  .EQ.  4)  GO  TO  1 150 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

(^kkkkkkkkkkkkk  Next  7  perf,  does  not  need  middle  web  *kkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


IF  (ICODEP  .GT.  7)  WRITE  (7.  8070)  A3  (1 1) 

Qkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkk  Finally  the  OUter  Web  kkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

WRITE  (7.  8080)  A3  (12) 

END  IF 

1150  CONTINUE 

IF  (OOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6260) 

WRITE  (2.  6270)  A1  (9) 

ICODEP  =  INT  (A3  (45)  -»•  .5) 

IF  (OCODEP  .EQ.  II)  .OR.  (ICODEP  .EQ.  13))  ICODEP  =  2 
IF  (ICODEP  .EQ.  12)  ICODEP  «  3 

Ckkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 
(^kkkkkkkkkkkkkkkkkkkkkkkk  Spheit  ************************************** 
Ckkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

IF  (ICODEP  .EQ.  I)  THEN 
WRITE  (2.  8010)  A3  (8) 

GOTO  1160 
END  IF 


. . . . . . . 

Qkkkkkkkkkkkkkkk  Remaining  grains  all  need  length.  ***kkkkkkkkkkkkkkkkk 
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^  4n|i  4i «  «  4i «  4. 41 4i  4>  4i  *  4i  *  %  4^  4>  4>  4<  *  *  Hiiii  4ii^  *  4>  4i  4>  4i  *  4^  *  4>  *  *  *  «  •  4>  4i  *  4i  4<  4<  >l<  >•' W  *  4>  It>  4' %  4"^  4>  >•>  %  4< 

WRITE  (2.  8000)  A3  (7) 

^  *  4i  4i  *  «  *41 41 «  «  *  «i  4r  <■  4r  4i  4i  4>  ili  *  4i  4i 4i «  *  4<  ^  4i  %  4i  *  *  4i  4i  *  III «  «  4r  4i  4r  4i  *  4<  1^  i|>  4i  4i  4<  *  *  4i  *«  4>  *  4>  4<  4>  *  4>  *  «> 

(^*4.4>4i4<4>*4>**4i4>*4.4>  ^ext  thc  rcctangulaT  strip  is  done  **•****♦♦>•■***♦***** 

^4I4I4•4'4<4>4l4i4i4i4i*4i4I*4<4l*4l4'*4<4'4•*4>4>4<*4'**4l4>4i4■4■*4>4l4<4<*4i4>4i«<4>4^*4I4^**4^4>4>4>4'4>4>4'4>4<4>4<4l4>4* 

IF  (ICODEP  .EQ.  3)  THEN 
WRITE  (2.  8020)  A3  (8) 

WRITE  (2,  8030)  A3  (10) 

GOTO  1160 
END  IF 

^4i4>4'**4i4i*4i4>4i4>4i4<*4>4>4>4i4i4>**4i4>4i4i**4>*4>4<4>*4>***4i*4'4i4'4>4i*4i4i4<4i4>4i4i4<***4'*4>*4'4i4r4<4<4>4>4> 

C***********  The  remaining  grains  all  need  a  diameter  *♦**♦**•**••*♦**♦ 

Q*4<4>4>4>4>4i4i***4i4i*4<*****4i4i**4>**4i*4i*4i4i4i4>*4>**4i4i4>*4i**4i4>4>4<*4>**4i4i4i4i4>4i4i4i4>*4>4i4i*4i4i 

WRITE  (2.  8010)  A3  (8) 

^4>4>4>4>****4>*4>******4i***4>4<***4i**4r4>4i*4i4<4i4i*4i**4>4i*4i4i4>**4i*4i4>4i****4i4iiK4<*4i*4i**4i* 

(^*4<4>****4'*4>4<4>  copj  needs  only  a  length  and  width  **•*■»■***♦*»-♦**♦******* 

^4[*4>4<4<4>4i4c4t***4i4>*4i4>4i4i**4i**4'4<*4>4>4<4>4<4i4t**4i4i4>*4i**4i4i4<4<4i4i***4>4>4>4>4'*4>4>*4>4i4>4i*4i4i4i4i 

IF  (ICODEP  .EQ.  3)  GO  TO  1 160 

Q»4■4'*4>4>4■4>4>*4I4I4l4■*4>4i4l4•4i*****«'4>4<4■**4i**4i*4>*4I4■4i*4l4>4>4>4l4i4i4•4l4■4•4■4'4>4^*4i4>4<4l**4•**4^** 

C*********  All  remaining  grains  need  perf  diameter  ******************** 

^4>4i4i4>4>4<4i**4i4i4>*4>**4'**4i**4i4i4>4>**4i4i4i*4>4>*****4>4>4>4i*4'4i4i4>*4i4>4i4i4i4i4i4i4i4t4'4>4i*4>**4i4>*4i 

WRITE  (2.  8040)  A3  (9) 

^*4>4<*4<4i*4>4i«4i4>4>4i4>4>**4i4i4<**4>*4>4i4i**4i******4>4i4'4i4i*4'4i4i4i4i4>**4i4i4i**4i4i**4i**4i*4>4'*** 

^4i*4>4i4i4i****4'*****4>4i  Next  the  slotted  tube  ****************************** 

Q**itt**0ti*ti***^*ti*iti******************i*********************************** 


IF  (ICODEP  .EQ.  5)  THEN 
WRITE  (2.  8050)  A3  (11) 

GOTO  1160 
END  IF 

^*4i4r*4i4i4>4'**4i******4>*****»4<4r*4i4'*4i4r*4'«***4>i»*4>*4i*4i4i4t**4i*4i4i*4i***4i****4>4i4<4>4>* 

Q4r4r*4r*4r4i**4i*  nfmaming  grains  need  inner  web  ****‘****************** 

Q4i**ltl*4'***4^4■****4r*4i4l***4l*4^*4<*4i4l4^4>4^*4i*4i4i**<k*******4^4i*4i4i*4i*4>4i4l4i4l4^****4'**4i 

WRITE  (2,  8060)  A3  (10) 

Q**4>4r4i4i»4r«>»4i4>*4i4r4r4>***«***4>***4r*4i4<*4i****4i******4i***4>*4r4>4>4i**4i*4i4'4i*4i4i***** 

(>**4>4<4r4>4>4>*»*4i4>*4i  i-pcff  Cylinder  is  rmished  *•*•**•*•******••*•*•**•** 

Q*4i4l*»4>**4^*4l•***4^****4'**4l****»*4<4^4^4l4^*4i4i******4l4i*****4i***4l4i4i4I*4>4>*4i****** 

IF  (ICODEP  .EQ.  4)  GO  TO  1 160 

C«***»*»**»*»***********«***** . . 

(;;***4.*4>«>******  7  pgjf^  docs  not  need  middle  web  •****<■***•••**••*• 

. . . . . . . 

IF  (ICODEP  .<jT.  7)  WRITE  (2.  8070)  A3  (1 1) 

. . *************** 

^•***»****«********  pinaiiy  ihe  outer  web  •*•*••*•*••••*•••*•♦•••****** 

. . ************ . **** . ******** 

WRITE  (2.  8080)  A3  (12) 

END  IF 

1 160  CONTINUE 

. . *********** 
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C**********  Next  the  hardware  information  is  given  *■!■♦***************** 


IF  (aOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6280) 

6280  FORMAT(/,’  ’^X.’Bomb  Information’.lSX.’Gage  Information’) 
WRITE  (7.  6290) 

6290  FORMATC - - ’) 

WRITE  (7.  6300)  A1  (16).  A1  (15) 

6300  FORMATC  ’.’Bomb  Type  :’.A20,2X.’Gage  I.D.  :’.A20) 
WRITE  (7.  6310)  A3  (23).  A3  (19) 

6310  FORMATC  ’.’Bomb  Vol  (cc):’J^10.1.12X.’Input  Voltage: ’.F8.4) 
WRITE  (7.  6320) 

6320  FORMATC  *.36X. ’Constants  For  Fit:  A+Bx+C'^2’) 

WRITE  (7.  6330)  A3  (20) 

6330  FORMAT(’  ’.36X.’A:  ’.E12.5) 

WRITE  (7.  6340)  A3  (21) 

6340  FORMAT(’  ’.36X.’B:  ’£12.5) 

WRITE  (7.  6350)  A3  (22) 

6350  FORMAT(’  ’.36X.’C:  ’£12.5) 

WRITE  (7.  6250) 


Q  *  4>  *  «  *  *  «  *  *  «  4t  *  ^  41  *  *  4i  <1  *  *  «  4i  4> »  «  III  *  *  *  4i  4. «  4"ti  i4>  4t  *  *  4i  *  4i  4i  *  %  i|>  1*1  *  *  III  *  *  *  4i  *  i«>  <1  * 


C************  Specific  Infoimation  for  the  firing  ********************* 

Q4<4i4<4<4i«4i4i4'***4i4i4>4<4'4>4<4i4<4<4<4<4>**4i4'4'4>4<4»44>4>4i4i4i4i4i4>44c4i4'44i4i4<4<4<4i4<4<4>4<4>4<4<4'4i4i**4>4<>l<4<4> 


WRITE  (7,  6360) 

6360  FORMAT(’  ’,8X. ’Temperature  and  Charge  Mass  Information’) 

WRITE  (7.  6290) 

WRITE  (7,  6370)  A3  (25),  A3  (26) 

6370  FORMAT(’  ’, ’Propellant  Mass  (g)  :’.F9.4.6X,’ Igniter  Mass  (g):’.  F9.4) 
WRITE  (7,  6380)  A3  (27),  A3  (28) 

6380  FORMAT(’  ’.’Initial  Temp.  Prop.(K):’.F6.0,9X,’Igniter  Temp.(K):’,  F6.0) 
WRITE  (7.  6390)  A3  (24) 

6390  FORMAT(’  ’.’Initial  Bomb  Temp.  (K):’.F6.0) 

WRITE  (7.  6400)  A3  (46) 

6400  FORMAT(’  ’.’Number  of  Propellant  Grains:’.F9.2) 

EfJD  IF 

IF  ((lOUTCH  .EQ.  2)  OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6280) 

WRITE  (2,  6290) 

WITE  (2,  6300)  A1  (16).  A1  (15) 

WRITE  (2.  6310)  A3  (23).  A3  (19) 

WRITE  (2.  6320) 

WRITC  (2.  6330)  A3  (20) 

WRITE  (2.  6340)  A3  (21) 

WRITE  (2,  6350)  A3  (22) 

WRITE  (2.  6250) 

^4i4i*»*44i*4i»4i4>**4>4i***4>4r4i4>*4>4>*4i4i4*4i*4>*4i44>4r4i4i444>*4>4'4'4>4>4<4>4i44i44i4<4>4>4<4>4t4i4>4>4>**4i 
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Specific  Infonnation  for  the  firing  *♦***■•■***<' *********** 

^  4i  *  4i  4ii|i  *  «  *  Hi  *  *  *  «  *  *  *  «  *  *  «i »  «  *  *  *  *  iK  iK  *  *  4i «  4i  4>  4i «  «  4> «  «  *  «  *  *  «  41  *  ■)>  4iitiiK  Hr  4. 4.  *  *  «i «  «  «  Di  DC  *  «  4nti  4>  *  Id  * 


WRITE  (2,  6360) 

WRITE  (2.  6290) 

WRITE  (2.  6370)  A3  (25).  A3  (26) 
WRITE  (2.  6380)  A3  (27),  A3  (28) 
WRITE  (2.  6390)  A3  (24) 

WRITE  (2.  6400)  A3  (46) 

END  IF 


^4<******4i****************************************4>**4' 4141*41**41 41*41 4i*4i4>**4<* 

C********  NEXT  THE  RESULTS  ARE  PRINTED  -  SIXTY  LINES  TO  A  PAGE  ******* 

^4<****4i*4i*********4i**4i4'*****4i4<4<4i4<*******4>********4i*********4>4<*4<*4<4i4i4i4<4i4i 

CALL  CLEAR 


WRITE  (*,  *)  ’Normally  60  lines  are  printed  per  page’ 

WRITE  (*,  *)  ’However,  this  value  can  be  change  to  suit’ 
WRITE  (*,  *)  ’the  printer  being  used.  Do  you  wish  to  change’ 
WRITE  (*,  *)  ’the  default  setting  [Y/N].  Default  is  No.’ 
READ  (*.  5030)  A 
5030  FORMAT(Al) 

CALL  CLEAR 

IF  ((A  .EQ.  ’Y’)  .OR.  (A  .EQ.  ’y’))  THEN 
WRITE  (*,  *)  ’Enter  the  number  of  lines  per  page.’ 

READ  (*.  *)  NPAH 
ELSE 

NPAH  =  60 


END  IF 

OPEN  (UNIT  =  12.  FILE  =  A1  (10)) 

REWIND  (UNIT  =  12) 

CALL  CLEAR 

NUMB  =  INT  (A3  (100)  +  .5) 

WRITE  (*,  6410)  NUMB 

6410  FORMAT(10X,’Therc  are’,15,’  lines  of  output  from  the’, 
l/.lOX.’compuutioa  The  amount  of  lines  printed  can’, 

2/,10X,’be  r^uced  by  specifying  a  "skip"  factor.  A’, 

3/.10X,’skip  factor  of  1  will  print  all  lines,  a  skip’, 

4/,10X,’factor  of  2  will  print  every  other  line,  etc.  ’, 

5/,10X,’Entcr  your  choice  for  a  skip  factor.’^/) 

READ  (•■  •)  ISKIP 

IF  (GOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6420)  NAMY 
END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6420)  NAMY 
END  IF 

6420  FORMAT(’l‘.’  OUTPUT  FILE:  ’.A20) 

^4i4i4i**4i4i*4i4i4i4i4i4i4i4i4>4i4i4i4<*4<***4i4>******************************4>************ 


(^*41*414141*41414141*41*****  PIrST  three  lines  of  OUTPUT  ARE  BLANK  ************** 


(^**********************************************************11************ 
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READ  (12.  5040)  LINE 
READ  (12,  5040)  LINE 
READ  (12.  5040)  LINE 
NUMPAG  =  0 
1170  CONTINUE 

READ  (12.  5040,  END  =1180)  LINE 
IF  (OOm  CH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6430)  LINE 
END  IF 

IF  (aOUrai  .EQ.  2)  .OR.  aOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6430)  LINE 
END  IF 

NUMPAG  =  NUMPAG  +  1 
IF  (NUMPAG  .EQ.  NPAH)  THEN 
IF  ((lOUTCH  EQ.  1)  .OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6420)  NAMY 
END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6420)  NAMY 
END  IF 
NUMPAG  =  0 
END  IF 

IF  ((LINE  (1:1)  .NE.  ’N*)  .AND.  (LINE  (2:2)  .NE.  ’N’))  GO  TO  1170 
NSKIP  =  0 
1190  CONTINUE 

READ  (12.  5040,  END  =1180)  LINE 
5040  FORMAT(A132) 

6430  FORMATC  •,A132) 

NSKIP  =  NSKIP  +  1 
IF  (NSKIP  .EQ.  ISKIP)  THEN 
NSKIP  =  0 

NUMPAG  =  NUMPAG  +  1 
IF  (OOUTCH  .EO.  1)  OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6430)  LINE 
END  IF 

IF  (OOUTCH  .EQ.  2)  .OR,  OOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6430)  LINE 
END  IF 

IF  (NUMPAG  .EQ.  NPAH)  THEN 
NUMPAG  =  0 

IF  (OOUTCH  .EQ.  1)  .OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6420)  NAMY 
END  IF 

IF  (OOUTCH  .EQ.  2)  .OR.  OOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6420)  NAMY 
END  IF 
END  IF 
END  IF 
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GOTO  1190 
1180  CONTINUE 

IF  (aOUTCH  .EQ.  1)  .OR.  aOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6430)  LINE 
END  IF 

IF  ((lOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6430)  LINE 
END  IF 

CLOSE  (UNIT  =  12) 

^  *  4>  *  *  4>  4<  *  Hi  *  *  iti  4i  4  *  41*  *  *  4ii|<  4i  4i  *  4<  *  *  *  Ki  *  *  *  %  it>  %  *  Ik  *  *  *  iti  4' <<  !<•  %  4i  «>  *  4>  * 

C4I4I4.***  need  SUBROUTINE  TO  STRIP  OFF  THE  INFORMATION  DESIRED  ********** 
C**4-*4i4.  burn  rate  for  options  1.  4  &  5.  SUR1=ACE  AREA  FOR  OPTION  3  ****** 
C******  and  time  pressure  FOR  OPTION  2  ******************************** 

^  4<  4i  4i  4<  4i  *  4i  *  4i  4i  4i  *  4<  *  *  4i  4>  4i  4>  *  4<  4>  4<  4>  4>  4i  4>  4i  4i  4i  4<  4i  *  4i  4<  4<  4<  *  4>  4<  4<  4i  4<  4<  4<  *  *  *  *  4i  *  *  4i  4<  4<  4<  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4>  4i  4<  4< 

1200  CONTINUE 
KNOUT  =  0 

lOPT  =  INT  (A3  (2)  -I-  .5) 

OPEN  (UNIT  =  12.  FILE  =  A1  (10)) 

REWIND  (UNIT  =  12) 

DO  12101  =  1.  5000 
READ  (12,  5050.  END  =  1220)  CHART 
5050  FORMAT(A2) 

IF  ((CHART  .EQ.  *  N’)  .OR.  (CHART  .EQ.  ’N  ’))  THEN 
BACKSPACE  (UNIT  =  12) 

KNOUT  =  KNOUT  1 

READ  (12,  5060)  WORDl,  WORD2,  XI,  X2,  X3.  X4,  X5,  X6,  X7 
5060  FORMAT(A9,A10.7E16.8) 

IF  (KNOUT  .EQ.  1)  A3  (48)  =  X5 
ELSE 

GO  TO  1210 
END  IF 

IF  (X4  .LE.  0.0)  THEN 
KNOUT  =  KNOUT  -  1 
GO  TO  1210 
END  IF 

IF  (aOPT  .EQ.  1)  .OR.  (lOPT  .EQ.  4)  .OR.  (lOPT  .EQ.  5))  THEN 
FRAT  (KNOUT,  1)  =  X2 
FRAT  (KNOUT.  2)  =  X4 
FRAT  (KNOUT.  3)  =  0.0 
END  IF 

IF  (lOPT  .EQ.  3)  THEN 
FRAT  (KNOUT.  1)  =  (A3  (25)  -  X3)/A3  (25) 

FRAT  (KNOUT,  3)  =  X5/A3  (48) 

FRAT  (KNOUT,  2)  =  X7 
END  IF 

IF  (lOPT  .EQ.  2)  THEN 
FRAT  (KNOUT.  1)  =  XI 
FRAT  (KNOUT.  2)  =  X2 
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I 


FRAT  (KNOUT.  3)  =  0.0 
END  IF 

1210  CONTINUE 
1220  CONTINUE 
CLOSE  (UNIT=  12) 


graphics  FILE  IS  WRITTEN 

Ql^*!tL*t^ltlm**^l^l^^^i^^^^^l^nt^l****^^*ltl**|^****’tl*************<^**’k******‘*******l******* 


DO  1230  J  =  1.  KNOUT 

WRITE  (9.  *)  FRAT  (J.  1).  FRAT  (J.  2).  FRAT  (J,  3) 

1230  CONTINUE 
CLOSE  (UNIT  =  9) 

^4<4i4i4»I<<<4i*4i**«4i4i  BURN  RATES  ARE  WRITTEN  *'*'4'****X"I"I<*4'*>)‘'><****'<<')"I<‘X**'I'4'**4>** 


IF  (GOPT  .EQ.  2)  .OR.  GOPT  EQ.  3))  GO  TO  1240 
^4>itiit<*«4i*4i4i4i**4ii|i4ti|<*  p[p^37'  3££  {p  ppj'  [§  DESIRED  ************************ 

QHc*^i*iitilf*^m**********************************************m***m********** 

CALL  CLEAR 
IFLAG=  1 


WRITE  (*.  6440) 

6440  FORM ATG/A15X, 'The  bum  rate  versus  pressure  often  requires’, 

1/,15X, 'filtering  to  remove  oscillations.  Do  you  wish  to’, 

2/,lSX.’determme  the  effect  of  the  FFf?  (Yes=l.  No=2) 

3/,15X,’Enter  your  choice.’,/) 

READ  (•,  •)  IFFT 
-  IF  (IFFT  .EQ.  1)  THEN 
IFLAG  =  2 
END  IF 

CALL  BRFFT  (Al.  IFLAG) 

(;<4.4<4i**4>4.4>4.4i4i4i«4.  PRINTING  INFORMATION  ON  THE  FFT  ********************** 


IF  (IFFT  .EQ.  1)  THEN 
CALL  CLEAR 


WRITE  (*,  *)  'Is  FFT  filtered  data  being  used  for  the  bum  ratio?’ 
WRITE  (*,  *)  'Enter  your  choice.  (Yes  =  1,  No  =  2)’ 

READ  (•,  •)  JRTI 
IF  (JRTI  .EQ.  1)  THEN 

IF  (GOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  3914) 

3914  FORMAT(///.10X,’FFT  filter  used  on  bum  rate  data.’) 

END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  3914) 

FNDIF 
END  IF 
END  IF 


^  *  *  *  «■ «  *  4>  4i  m  *  4i  *  4>  Hi  *  4ii|i  4i  I**  4i  4>  *  4i  *  «  *  *  *  *  4> «  «  *  4>  O*  «  *  *  *  *  4r  *  *  IK  «  «  *  Hi  *  *  4c  *  4nti « Ik  « It<  *  4«< «  *  *  Hi  4>  * 
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C*******  NEED  TO  DETERMINE  WHERE  THE  FFT  DATA  IS  STORED  **************  * 
C*******  LOAD  FFT  DATA  INTO  ARRAY  FRAT,  AND  RECOPY  IT  TO  **********•**•!■ 
C*******  GRAPHICS  FILE  IF  ITLTERED  DATA  IS  TO  BE  USED  ***************** 

Q4i4i4i4c«i|iiti4i4iitc*4i*4t4i4i4i***************************************************** 

C**********  NEED  TO  INTERPOLATE  AT  STEPS  OF  4  MPa  ********************* 
C**********  STORE  THE  DATA  IN  FRAT  WITH  NUMBER  AS  KKN  ***************** 
Q***********  will  store  A  COPY  IN  XLFRAT  ****************************** 

^  «  *  *  «  «  «  »  *  *  *  *  *  *  Ik  *  4i  4i  *  I#  Ik  *  Ik  *  III «  «>  Hi  4i «  *  4> « Ik  *  *  I|<  *  41 «  4i  4c  *  ||||||  *  I|>  III  *  *  *  *  «  *  41 «  *  *  41  *  *  Iti  *  * 

Q4I************  reread  graphics  file  IN  CASE  FILTERED  DATA  ************ 
(>4<************  IS  TO  BE  USED,  IFLAG=2  MEANS  FILTERED  DATA  ************* 

^4i4i**4i*4i*******4i******************************************************* 


IF  (IFLAG  .EQ.  2)  THEN 
OPEN  (UNIT  =  9.  FILE  =  A1  (17)) 

KNOUT =  1 
1250  CONTINUE 

READ  (9,  *.  END  =  1260)  FRAT(KNOUT.  1).  FRATl 
(KNOUT,  2),  FRAT  (KNOUT,  3) 

KNOUT  =  KNOUT  +  1 
GO  TO  1250 
1260  CONTINUE 

KNOUT  =  KNOUT  -  1 
CLOSE  (UNIT  =  9) 

END  IF 

DO  1270  I  =  1,  KNOUT 
XLFRAT  a.  1)  =  FRAT  G.  1) 

XLFRAT  a.  2)  =  FRAT  (I,  2) 

1270  CONTINUE 


^4i***********************ik********************************************* 


Q4<********  DETERMINE  UPPER  AND  LOWER  MULTIPLE  OF  4  MPA  **************** 

^4i4i4i4i4i******************4i********************************************** 


DO  12801  =  1,  1000 
TEST  =  1*4 

IF  (FRAT  (1,1)  .LE.  TES'F)  THEN 


NS  =  1*4 
GO  TO  1290 
END  IF 

1280  CONTINUE 
1290  CONTINUE 

NT  =  INT  (FRAT  (KNOUT,  l)/4.)*4 


(^ik4i***********************************4i*********4i********************** 

Q4i4iik*ik*************  ]vi0W  THE  INTERPOLATION  ***************************** 

Q4i4i******************************************************************** 


JQRY  =  0 

PMAX  =  FRAT  (KNOUT,  1) 
KKN  =  0 


DO  1300  I  =  NS,  NT,  4 
KKN  =  KKN  +  1 


FRAT  (KKN,  1)  =  I 
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DO  1310  J=  1,  KNOUT 
X  =  I 

IF  (X  .LE.  XLFRAT  (J.  1))  THEN 

FRAT  (KKN,  2)  =  (X  -  XLFRAT  (J  -  1,  1))/(XLFRAT  (J,  1)  -  XLFRAT  (J  -  1.  1))* 
1  (XLFRAT  (J.  2)  -  XLFRAT  (J  -  1.  2))  +  XLFRAT  (J  -  1,  2) 

DO  1320  KIX  =  1.  15 
ITESTIT  =  INT  CTAL  (KIX.  1)  +  .5) 

IF  (ITESTIT  .EQ.  I)  THEN 
TAL  (KIX.  2)  =  FRAT  (KKN.  2) 

JQRY  =  JQRY  +  1 
END  IF 

1320  CONTINUE 
GO  TO  1300 
END  IF 

1310  CONTINUE 
1300  CONTINUE 

^  noli  *  Id  *  4>  *  4>  *******  4<  It!*  O' «<  4i  4>  <<****  4<4<  i|>  4»K  *  4<*  *****  «***  XoK  »  O*  «<  ««****  * 

^**********************  PRINT  THE  RATES 
^********************************************************************** 

CALL  PRAT  (FRAT.  KKN.  lOUTCH) 

^********************************************************************** 
C********  SUBROUTINE  TO  DETERMINE  THE  BURN  RATE  LAWS  ****************** 

Q********************************************************************** 

CALL  BRNRT  (Al.  lOUTCH) 

1240  CONTINUE 
CLOSE  (UNIT  =  2) 

^********************************************************************** 
(;<*****************  SUMMARY  OUTPUT  ROUTINE  GOES  HERE  ******************* 
Q*****************  ALWAYS  TO  PRINTER  ********************************** 

^4i4i4i4<«i4i4i4i4<4i**d4i4i*idid4><d4<4<*4i>d4i4i***4i<d4>ididdid4>d4id4iddd4ididid>did>dd'l<dd>dd4idid4>iddid>ddidd4< 


IF  ((lOPT  .EQ.  2)  .OR.  (lOPT  .EQ.  3))  GO  TO  1330 
CALL  CLEAR 
WRITE  (*.  6460) 

6460  FORMAT(//.l OX. ’Summary  Output  Sheet  to  Printer?  (Yes=l.  No=2)’) 
READ  (*.  *)  ISUMM 
IF  aSUMM  .EQ.  2)  GO  TO  1340 
IF  aOUTCH  .EQ.  2)  OPEN  (UNIT  =  7.  FILE  =  ’LPTl’) 

WRITE  (7.  6420)  NAMY 
WRITE  (7.  6470)  Al  (4) 

6470  FORMATC  Information  File;’.A20.8X. ’Pressure’. lOX. ’Bum  Rate’) 
WRITE  (7.  6480)  Al  (1) 

6480  FORMAT(’  Project  Name  :’.A20.10X.’(MPa)’.12X.’(cm/sec)’) 

IF  (JQRY  .GE.  1)  THEN 
WRITE  (7.  6490)  Al  (6).  TAL  (1.  1).  TAL  (1.  2) 

6490  FORMAT(’  PropeUant  Type  ;’.A20f  14.1.9X.F9.3) 

ELSE 
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WRITE  (7.  6500)  A1  (6) 

6500  FORMATC  PropeUant  Type  :’,A20) 

END  IF 

IF  (JQRY  .GE.  2)  THEN 

WRITE  (7,  6510)  A1  (9).  TAL  (2,  1).  TAL  (2.  2) 
6510  FORMATC  Grain  Geometry  :’.A20.F14.1,9X,F9.3) 
ELSE 

WRITE  (7.  6520)  A1  (9) 

6520  FORMATC  Grain  Geometry  :’,A20) 

END  IF 

IF  (JQRY  .GE.  3)  THEN 

WRITE  (7.  6530)  A3  (7),  TAL  (3.  1).  TAL  (3.  2) 
6530  FORMATC  Grain  Length(cm):’,F20.5.F14.1,9X,F9.3) 
ELSE 

WRITE  (7,  6540)  A3  (7) 

6540  FORMATC  Grain  Ungth(cm):’.F20.5) 

END  IF 

IF  (JQRY  .GE.  4)  THEN 

WRITE  (7,  6550)  A3  (8).  TAL  (4.  1).  TAL  (4.  2) 
6550  FORMATC  Outer  Diameter  ;*.F20.54^14.1.9X.F9.3) 
ELSE 

WRITE  (7.  6560)  A3  (8) 

6560  FORMATC  Outer  Diameter  :*J^0.5) 

END  IF 

IF  (JQRY  .GE.  5)  THEN 

WRITE  (7.  6570)  A3  (9),  TAL  (5.  1).  TAL  (5,  2) 
6570  FORMATC  Perf  Diameter  :’.F20.5,F14.1.9X,F9.3) 
ELSE 

WRITE  (7,  6580)  A3  (9) 

6580  FORMAT(’  Perf  Diameter  ;’.F20.5) 

END  IF 

IF  (JQRY  .GE.  6)  THEN 

WRITE  (7,  6590)  A3  (10),  TAL  (6.  1),  TAL  (6.  2) 
6590  FORMATC  Inner  Web  :’,F20.5J^14.1.9X,F9.3) 

ELSE 

WRITE  (7.  6600)  A3  (10) 

6600  FORMATC  Inner  Web  :’,F20.5) 

END  IF 

IF  (JQRY  .GE.  7)  THEN 

WRITE  (7.  6610)  A3  (11),  TAL  (7,  1),  TAL  (7,  2) 
6610  FORMAT(’  Middle  Web  :'J^0.5,F14.1,9X,F9.3) 
ELSE 

WRITC  (7,  6620)  A3  (11) 

6620  FORMATC  Middle  Web  :’J^0.5) 

END  IF 

IF  (JQRY  .GE.  8)  THEN 

WRITE  (7,  6630)  A3  (12),  TAL  (8,  1),  TAL  (8.  2) 
6630  FORMATC  Outer  Web  :’,F20.5.F14.1.9X,F9.3) 
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ELSE 

WRITE  (7.  6640)  A3  (12) 

6640  FORMATC’ Outer  Web  ;’.F20.5) 

END  IF 

^  <11^  *  <1  *  *  *  4i  *  «  Kiiti  <1  *  «  *  4141 4iiti  *  Id  111  *  III  g|<  *  4c  *41 4ii|i  4ii|i  Kiili  ]|i  411)1 «  41 4i  *  Kiiti  *  *  *  «  *  i|i  *  <1  *  iti  4i  Hi « 

C***************  CHECK  FOR  DETERRED  OR  LAYERED  GRAIN  ****************** 

^  Id  4c  4i  4c  4c  4i  4c  4i  4c  4i  4<  4c  4<  4i  4c  41 4c  4c  4i  4i  4>  d  4c  4i  cd  4c  4c  4c  4>  4c  4>  4c  4c  4c  <d  4i  4c  *  4i  4c  4<  4c  4i  4i  4c  4c  4c  4i  4i  4c  4c  4c  41 4c  4c  4c  4c  4c  4c  4c  4i  4<  4i  4c  4>  4c  4c  41 4c  4c 

NL  =  INT  (A3  (4)  +  .5) 

IFLAGY  =  0 

IF  (NL  .GT.  1)  IFLAGY  =  1 
IF  (JQRY  .GE.  9)  THEN 
WRITE  (7,  6650)  TAL  (9,  1).  TAL  (9,  2) 

6650  FORMATC  Prop  Thennocheins;’.20XJJ14.1,9X,F9.3) 

ELSE 

WRITE  (7.  6660) 

6660  FORMATC  Prop  Thermochcms:’) 

END  IF 

IF  (IFLAGY  .EQ.  1)  THEN 
IF  (JQRY  .GE.  10)  THEN 
WRITE  (7,  6670)  TAL  (9.  1).  TAL  (9.  2) 

6670  FORMATC  Layered/Deterted:’.20XJF14.1,9X,F9.3) 

ELSE 

WRITE  (7,  6680) 

6680  FORMATC  Layered/Deterred:’) 

END  IF 

IF  (JQRY  .GE.  11)  WRITE  (7.  6690)  TAL  (11,  1).  TAL  (11,  2) 

IF  (JQRY  .GE.  12)  WRITE  (7,  6690)  TAL  (12,  1),  TAL  (12,  2) 

IF  (JQRY  .GE.  13)  WRITE  (7,  6690)  TAL  (13,  1),  TAL  (13,  2) 

IF  (JQRY  .GE.  14)  WRITE  (7,  6690)  TAL  (14,  1),  TAL  (14,  2) 
iF  (JQRY  .GE.  15)  WRITE  (7,  6690)  TAL  (15,  1),  TAL  (15,  2) 

6690  FORMATC  ’,37X,F14.1,9XJF9.3) 

END  IF 

IF  (IFLAGY  .EQ.  0)  THEN 
IF  (JQRY  .GE.  10)  THEN 

WRITE  (7,  6700)  P  (2.  1.  1).  TAL  (10,  1),  TAL  (10,  2) 

6700  FORMATC  Impetus  (J/g)  ;’f20.5J^14.1,9X,F9.3) 

ELSE 

WRITE  (7,  6710)  P  (2,  1,  1) 

6710  FORMATC  Impetus  (J/g)  :’J^0.5) 

END  IF 

IF  (JQRY  .GE.  11)  THEN 

WRITE  (7,  6720)  P  (3,  1,  1),  TAL  (11,  1),  TAL  (11,  2) 

6720  FORMATC  Flame  Temp  (K)  :’,F20.5,F14.1,9X,F9.3) 

ELSE 

WRITE  (7,  6730)  P  (3,  1,  1) 

6730  FORMATC  Rame  Temp  (K)  :’.F20.5) 

END  IF 

IF  (JQRY  .GE.  12)  THEN 
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WRITE  (7,  6740)  P  (4,  1.  1),  TAL  (12,  1).  TAL  (12.  2) 

6740  FORt4AT(’  Density  (g/cc)  :*.F20.5J^14.1.9X.F9.3) 

ELSE 

WRITE  (7,  6750)  P  (4.  1.  1) 

6750  FORMATC  Density  (g/cc)  :M=20.5) 

END  IF 

IF  (JQRY  .GE.  13)  THEN 

WRITE  (7,  6760)  P  (5.  1,  1),  TAL  (13,  1).  TAL  (13.  2) 

6760  FORMATC  Molecular  Weight;’Jf=^0.5J^14.1.9X,F9.3) 

ELSE 

WRITE  (7,  6770)  P  (5.  1.  1) 

6770  FORMATC  Molecular  Weight:’ J^O.5) 

END  IF 

IF  (JQRY  .GE.  14)  THEN 

WRITE  (7.  6780)  P  (6.  1.  1).  TAL  (14.  1),  TAL  (14.  2) 

6780  FORMATC  Covolume  (cc/g)  :’.F20.5.F14.1,9X.F9.3) 

ELSE 

WRITE  (7.  6790)  P  (6.  1.  1) 

6790  FORMATC  Covolume  (cc/g)  :*J^0.5) 

END  IF 

IF  (JQRY  .GE.  15)  THEN 

WRITE  (7,  68(X))  P  (7.  1.  1).  TAL  (15,  1).  TAL  (15,  2) 

6800  FORMATC  Gamma  :’,F20.5.F14.1.9XJ^.3) 

ELSE 

WRITE  (7.  6810)  P  (7,  1,  1) 

6810  FORMATC  Gamma  :’.F20.5) 

END  IF 
END  IF 

^  4i  *  *  4i  *  *  *  « Ik  *  *  *  *  4>  *  *  4t «  *  *  4>  *  *  *  «>  4c «  *  4<  *  4>  4<  *  4<  *  <•>  it> « i)<  O' 4c  i|<  Hi  «  *  4iiti  *  » >t<  trilc  %  w  *  *  Hcili  %  4t  * 

^4i4c4i4c4>4>*ck4i4t*4c4i4<4c  NEXT  BURN  RATE  LAWS  •****'•'♦*******'<'***♦*'•"<■************* 
^  4>  4>  4c  4<  4c  4i  4i  4|  4i  4i  4i  4c  4i  4>  4i  4c  4i  4' 4c  4c  4>  4c  4c  4c  4c  4c  4>  4c  4c  4c  4<  4>  4i  4c  4i  4c  4c  41 4i  4c  4i  4<  4i  4c  41 4i  4i  4i  4i  Ik  4i  Ik  4i  4i  4i  4|  4' 4c  4>  4>  4>  4i  4i  4|  *  4i  4i  4i  4|  4|  4> 

OPEN  (UNIT  =  18,  FILE  =  A1  (18)) 

REWIND  (UNIT  =  18) 

READ  (18.  *)  NN 
IF  (NN  .GT.  8)  THEN 
NS  =  NN  -  7 
DO  1350  I  =  1.  NS  -  1 
READ  (18,  *)  X.  Y.  Z.  W.  T 
1350  CONTINUE 
ELSE 
NS=  1 
END  IF 

WRITE  (7.  6820) 

6820  FORMATC  ’.’Bum  Rate  Laws  (MPa  &  cm/sec)’) 

WRITE  (7,  6830) 

2001  FORMAT(’  Pressure  -  Prcssure’,2X,’Coefr,7X.’Exp’,4X,’Corr  Coeff) 

DO  1360  I  =  NS,  NN 
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READ  (18,  *)  X.  Y,  Z,  W,  T 
WRITE  (7,  6840)  X,  Y,  Z.  W.  T 
6840  FORMATC  ’JJ8.2.4X.F8.2J=9.6.2X.F8.4.2X.F10.7) 
1360  CONTINUE 

CLOSE  (UNIT  =  18) 


Q  *  4i«  «  *  *  «  4,  *  Hi  *  «  <1 4i  4, 4i «  *  il> « III  *  4,  *  *  *  *  4>  41 4i  4>  *  *  iti  i|i  *  *  41 4<  it>  i|<  i|c  4ii«c  4c  4, 4c  *  *  *  Ik  4c  ,|c  *  i|< « >k  *  :|c  4, *  4c  *  i|,  it< 

C4.***4.*4.4.4c4.4.4i4.4i4i  RNALLY  THE  GR.APH  OF  THE  PRESSURE  VS  RATE  ************* 

^  4c  4i  4i  4i  4i  4c  Ik  4c  *  «  *  *  4i  Ik  4>  4i  4i  4>  *  4>  4>  4i  4c  4i  *  *  *  4i  4<  4i  4i  4<  41 4c  4i  4i  4c  *  4i  4c  4i  4i  4c  4<  4c  4<  4>  4i  4i  4i  4c  4c  4c  Ik  4>  4c  4>  4>  4<  4<  4<  4i  4i  4c  4i  4c  4i  4c  4<  4i  4< 
Q4c4c4c4c4c4c4c4c4c4ckik4c4c4i4c4i4c4c4i  F[RST  FIND  THE  RANGES  ON  AXIS  *4c4c4cik4c4c4cik4c4c4c4c4c4c4c4c4cik4c 
^Ik4c4.4c4cik4c4c4c4c4c4c4c4c4c4c4c4c4c4c  PRESSURE  IS  FIRST  AND  LAST  ENTRIES  4c4c4c4c4c4c4cik4c4c4c4.4c4c4c 
Qkk4i4c4c4c4c4c4c4i4c4c4c4c4c4ck4c4c4c  SEARCH  THE  RATES  4c 4c 4c 4c 4' 4> 4c 4c 4> 4c 4c 4> 4c 4c 4i 4c 4c 4c 4c 4c 4c 4i 4c 4c 4c 4i 4c 4c 4i 4c 4i 4c 4c 
Q  4c  4c  Ik  *  4c  4i  4c  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  k  4c  4c  4c  k  4c  4c  4c  4c  4c  4c  4>  4>  4c  4c  4i  4c  4c  4c  4c  4>  4i  4c  4<  4c  4c  4i  4c  4i  4c  4c  4c  4>  4c  4c  4c  4c  4c  4c  4c  4<  4c  4c  4c  4c 

(;<kkkkkkkkkkkkkkkkkkk  need  to  reread  the  GRAPHICS  FILE  ***********‘**‘**** 

^kkkkkkkkkkkkkkkkkkkk  NEED  TO  USE  FILTERED  DATA  4ckkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk4'kkkkkkkkkk 


OPEN  (UNIT  =  14.  FILE  =  A1  (17)) 

REWIND  (UNIT  =  14) 

KNOUT  =  0 
1370  CONTINUE 

KNOUT  =  KNOUT  +  1 

READ  (14.  *,  END  =  1380)  XLFRAT  (KNOUT.  1),  XLFRAT  (KNOUT,  2).  XXX 
GO  TO  1370 
1380  CONTINUE 

KNOUT  =  KNOUT  -  1 
CLOSE  (UND’  =  14) 

PMAXY  =  XLFRAT  (KNOUT.  1) 

PMINY  =  XLFRAT  (1.  1) 

RMAXY  =  XLFRAT  (1,  2) 

RMINY  =  XLFRAT  (1.  2) 

DO  1390  I  =  1.  KNOUT 

IF  (XLFRAT  (I.  2)  .LT.  RMINY)  RMINY  =  XLFRAT  (I,  2) 

IF  (XLFRAT  (1,  2)  .GT.  RMAXY)  RMAXY  ^  XLFRAT  (1.  2) 

1390  CONTINUE 

WRITE  (7,  6850)  PMINY,  PMAXY.  RMINY.  RMAXY 
6850  FORMAT(/,’  ’.’Hor.  Axis:’,F8.2,’  to  ’.F8.2.’  MPa  ::  Vcr.  y»xis:’. 

1F9.5,’  to  ’.F9.5,’  cm/sec’) 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 


(^kkkkkkkkkkkkkk  AXIS  INCREMENT  IS  DETERMINED  4.kkkkkkkkkkkkkkkkkkkkkkkkkk 
^kkkkkkkkkkkkkkkkk  AXIS  LOADED  INTO  ARRAY  4ckkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

^kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 

VI  =  RMINY 
V4  =  RMAXY 
HI  =  PMINY 
H4  =  PMAXY 

PMAXY  =  ALOGIO  (PMAXY) 

PMINY  =  ALOGIO  (PMINY) 

RMAXY  =  ALOGIO  (RMAXY) 

RMINY  =  ALOGIO  (RMINY) 
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HSTEP  =  (PMAXY  -  PMINY)/60. 
VSTEP  =  (RMAXY  -  RMINY)/30. 
DO  1400  I  =  2.  60 
APL  (1. 1)  = 

1400  CONTINUE 
APL  (1,  20)  =  T 
APL  (1,40)=  T 
APL  (1.  60)  =  T 
DO  14101  =  1,30 
APL  (I.  1)  =  T 
1410  CONTINUE 
APL  (1,  1)  =  •+’ 

APL  (10,  1)  = 

APL  (20,  1)  = 

APL  (30,  1)  = 


Q  Di  i|i%  *  4t  *41  *4i  I),  4>  4ii4i  4, ««  4i  Ik  *  4> «« it<  >*<*  **«*«*«;«  i|>  <•"«»•>  >!•>•<**«  4>  4i  *  Ik  *  4<  >*>  4<  ti  Ik 

QtL^^rn**************  plotting  points  IN  ARRAY  *************************** 

^  4i  4>  4i  4<  4i  4<  *  4i  *  4i  4i  *  4i  4i  4i  41 4<  4i  4i  *  Ik  4i  4i  4i  4i  4i  4<  4i  4i  4<  4<  4i  4|  4<  4i  4<  4i  4i  *  4i  4i  *  4|  4i  4<  Ik  4i  4>  >k  4<  4<  4i  4|  4i  4i  4i  4i  *  4|  Ik  4i  Ik  *  Ik  Ik  4<  4>  4>  >k  4<  4i 


DO  14201  =  1,  KNOUT 
X  =  ALOGIO  (XLFRAT  0.  D)  -  PMINY 
Y  =  ALOGIO  (XLFRAT  0.  2))  -  RMINY 
IX  =  INT  (X/HSTEP  +  .5)  +  1 
lY  =  INT  (YA^STEP  +  .5)  +  1 

IF  (OX  .GT.  60)  .OR.  ax  .LT.  0)  .OR.  (lY  .GT.  30)  .OR.  (lY  .LT.  0))  GO  TO  1420 
APL  (lY,  IX)  =  •*’ 

1420  CONTINUE 

^  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  *  4i  *  4i  4i  4i  *1 4>  *  *  *  *  *  4<  *  *  *  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  Ik  4i  4i  4i  4i  4<  4>  4i  Ik  4i  4i  4i  4i  4i  4i  4i  Ik  4i  4i  Ik  4<  4>  4i  4>  4i  4i  4i 

(;i4i4i4i*4iik4i*4.*4.k4iik  PLOTTING  THE  GRAPH  TO  PRINTER  ***4i***********4.ikikik*4iik4i4i4i4i 

^  4i  4i  4i  4i  4i  41 4i  4i  4i  *  *  4i  *  *  *  4i  4: 4i  4i  4i  4i  4i  *  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  *  4i  4i  *  *  Ik  4i  4>  *  4i  4i  4i  4. 4. 4i  4i  Ik  4i  4i  4c  4i  4i  4i  4i  4i  4c  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i 

8090  FORMATC  ’,F9.5.5X,A60) 

8100  FORMATC  M4X,A60) 

DO  14301  =  30,  1,  -  1 
DO  1440  J  =  1,60 
ITEMP  (J:J)  =  i\PL  a.  J) 

1440  CONTINUE 

IF  (I  .EQ.  30)  THEN 
WRITE  (7,  8090)  V4,  ITEMP 
ELSE  IF  (I  .EQ.  20)  THEN 
V3  =  10  ••(20.*VSTEP  +  RMINY) 

WRITE  (7,  8090)  V3.  ITEMP 
ELSE  IF  (I  .EQ.  10)  THEN 
V2  =  10.**(10.*VSTEP  +  RMINY) 

WRITE  (7,  8090)  V2,  ITEMP 
ELSE  IF  (I  .EQ.  1)  THEN 
WRriE  (7,  8090)  VI.  ITEMP 
ELSE 

WRITE  (7.  8100)  ITEMP 
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END  IF 

1430  CONTINUE 

(^«*4,**«*****4,**  FINALLY  SCALE  ON  HORIZONTAL  AXIS  *********************** 

^*iti4iitii|<4i4i4i*4<4i4c*4i4ii|i4i4i4i4ii|iit<i»**i|.iti4i4i4.4i*4iiti4iiti4c4c4>4c4titi4c4i*4>4i4<4.i|.i|<***********4i>K  >•<****** 


H2  =  10.**(20.*HSTEP  +  PMINY) 

H3  =  10.'‘*(40.*HSTEP  +  PMINY) 

WRITE  (7.  6860)  HI,  H2.  H3,  H4 
6860  FORMATC  ’,9X.F6.0.14XJ^6.0.14X.F6.0.14Xj:6.0) 


Q*iii4ti|i4ii|i4<4<*4f4i4iili*4iiki#*iti4<i|i4i4i4iitii|i4<  pININSHED  THE  OUTPUT  ********************** 

^4ii|ii|i4r*>K*4i4i**4>4i4iiti4i4i****i|c**«4t4i4i*<|i4>*4i****i|i*«it<4<*«4i***4iitii|ii|>ik4i«i|c*iKi^**4i4i4ritc4i«*4i4t«> 

1330  CONTINUE 
1340  CONTINUE 
END 

04i4i4i*iti*4t4ii|>4i*4i4<4i*4i4f«4i«4i4i4i4i«4i4i4i4>4>4>*4<**********4>4r********4>***it>4>4>*********** 

(2**************  SUBROUTINE  TO  PRINT  RATES  IN  TABLE  ********************* 

^  *  4i  *  *  *  *  *  4< «  4<  4<  *  *  *  *  *  4>  *  *  *  *  *  » ikiti  *  4<  «>  4<  4>  *  «  *  4>  *  *  *  *  4ii|[  4iiti  *  *  4t  it>  4<  4i  *  *  *  *  *  4>  *  iliiti  Hi  4c «  «  *  *  *  *  *  *  4i 


SUBROUTINE  PRAT  (FRAT,  KNOUT,  lOUTCH) 

^  4<  4<  4c  4>  *  4>  4i  4<  4>  4<  *  *  4i  4i  4i  4<  4<  41 4c  4i  4c  4c  4<  4>  4i  4<  4>  4c  4i  4i  4>  4i  4<  4i  4>  4c  4>  4c  4>  4c  4i  4i  4<  4c  4c  4>  *  4>  4>  4<  4' 4<  4c  4c  4' 4c  4t  4i  4c  4i  4>  4>  4>  4<  4c  4c  4t  4c  4>  4c  4i 

C  THIS  PROGRAM  WILL  WRITE  A  TABLE  OF  PRESSURE  VS  RATE 

C  WRITTEN  BY:  WILLIAM  OBERLE,  BRL  MARCH  1987 

^  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  c4  4c  *  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ****  4c  4c  4c  4c  4c  4c  4c  4c  *  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  4c  ck  4c  4c  4c  4c  4c  4c  i4  4c 

DIMENSION  FRAT  (1024,  3),  PRESS  (1024),  RATE  (1024) 

DO  10001=  1,  KNOUT 
PRESS  G)  =  FRAT  (I,  1) 

RATE  (I)  =  FRAT  G.  2) 

1000  CONTINUE 
NN  =  KNOUT 
Nil  =  1 

1010  CONTINUE 

IF  (GOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6000) 

WRITE  (7,  6010) 

WRITE  (7,  6020) 

WRITE  (7,  •) 

END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6000) 

WRITE  (2,  6010) 

WRITE  (2,  6020) 

WRITE  (2,  *) 

END  IF 

IF  GW  .LE.  165)  THEN 
N1  =  Nil 

N2  =  N11  +NN-  1 
NFLAG  «  1 
ELSE 
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N1  =N11 
N2  =  N11  +  164 
NN  =  NN  -  165 
Nil  =N11  +  165 
NFLAG  =  0 
END  IF 

NUM  =  N2  -  N1  +  1 
XNUM  =  NUM 
NROWS  =  XNUM/3 
NLEFT  =  NUM  -  NROWS*3. 

IF  (NLEFT  .LT.  1)  THEN 
DO  1020  1=  1,  NROWS 
NI  =  N1  +  I  -  1 

IF  (GOUTCH  .EQ.  1)  .OR.  GOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6030)  PRESS  (NI),  RATE 

1  (NI),  PRESS  G«  +  NROWS), 

2  RATE  (NI  +  NROWS),  PRESS  (NI  +  2*NROWS), 

3  RATE  (NI  +  2*NROWS) 

END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  GOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6030)  PRESS  (NI),  RATE 

1  (NI),  PRESS  (NI  +  NROWS), 

2  RATE  (NI  +  NROWS),  PRESS  (NI  +  2*NROWS), 

3  RATE  GH  +  2*NROWS) 

END  IF 

1020  CONTINUE 
ELSE 

IF  GJLEFT  .EQ.  1)  THEN 
DO  1030  I  =  1.  NROWS 
NI  =  NI  +  I  -  1 

IF  (GOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6030)  PRESS  (NI).  RATE  (NI). 

1  PRESS  (NI  +  NROWS  +  1) 

2  .  RATC  (NI  +  NROWS  +  1),  PRESS  (NI  +  2*NROWS  +  1) 

3  ,  RATE  Gn  +  2*NROWS  +  1) 

END  IF 

IF  ((lOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6030)  PRESS  (NI).  RATE  (NI), 

1  PRESS  GH  +  NROWS  +  1) 

2  .  RATE  (NI  +  NROWS  +  I).  PRESS  Gfl  +  2*NROWS  +  1) 

3  ,  RATE  (NI  +  2*NROWS  +  I) 

END  IF 

1030  CONTINUE 

IF  (GOUTCH  .EQ.  1)  OR.  GOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6040)  PRESS  (NROWS  +  NI).  RATE  (NROWS  +  NI) 
END  IF 

IF  (GOUTCH  .EQ.  2)  .OR.  GOUTCH  EQ.  3))  THEN 
WRITE  (2,  6040)  PRESS  GIROWS  +  NI),  RATE  GIROWS  +  NI) 
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END  IF 
ELSE 

DO  1040  I  =  1.  NROWS 
N1  =  N1  +  I  -  1 

IF  ((lOUTCH  .EQ.  1)  .OR,  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6030)  PRESS  (NI).  RATE  (NI). 

1  PRESS  (NI  +  NROWS  +  1) 

2  .  RATE  (NI  +  NROWS  +  1).  PRESS  (NI  +  2*NROWS  +  2) 

3  .  RATE  (NI  +  2*NROWS  +  2) 

END  IF 

IF  ((lOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6030)  PRESS  (NI).  RATE  (NI). 

1  PRESS  (NI  +  NROWS  +  1) 

2  .  RATE  (NI  +  NROWS  +  1).  PRESS  (NI  +  2*NROWS  +  2) 

3  .  RATE  (NI  +  2*NROWS  +  2) 

END  IF 

1040  CONTINUE 

IF  ((lOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6050)  PRESS  (NROWS  +  NI).  RATE  (NROWS  +  NI). 

1  PRESS  (NI  +  2*NROWS  +  1).  RATE  (NI  +  2*NROWS  +  1) 

END  IF 

IF  (OOUTCH  .EQ.  2)  .OR.  aOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6050)  PRESS  (NROWS  +  NI),  RATE  (NROWS  +  NI), 

1  PRESS  (NI  +  2*NROWS  +  1).  RATE  (NI  +  2*NROWS  +  1) 

END  IF 
END  IF 
END  IF 

IF  (NFLAG  .EQ.  1)  GO  TO  1050 
GO  TO  1010 

6030  FORMATC  M2X.F8.3.4Xi'8.3.4X.F8.3.4X.F8.3.4X.F8.3.4X.F8.3) 

6050  FORMATC  M2X.F8.3.4X.F8.3.4X.F8.3.4X.F8.3) 

6040  FORMATC  M2X.F8.3.4X.F8.3) 

6000  FORMATC  ry) 

6010  FORMATC  ’.13X,'Pressure*.6X,’Raic’.6X.’Pressurc’,6X.’Ralc’. 

1  6X,’Pressure’.6X.’Raie’) 

6020  FORMATC  M3X.’ . •.6X.’ — ’,6X.’ - •,6X,*-— 

1  6X.’ . ’.6X.*— -’) 

1050  CONTINUE 
RETURN 
END 

Q*********************  SUBROUTINE  CLEAR  *•*•***********•*****•*•*•**•*** 

SUBROUTINE  CTEAR 
CHARACTER  STM 
DATA  ST/’  (2J’/ 

WRITE  (*.  6000)  ST 
6000  FORMAT  (1X.A4) 
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RETURN 

END 

Q*  ***  4i4i»  4i*  Dull  4t  ***«  Kiitcit)  Dull  He  iX  «  He*  «  4>  Hi  4i  it<  *  iK  *  4141*  4t  **  4i4i***  4i  *  41  Hiiti  4i  *  itc*  **  O  i|>  41  *«  ******  * 

^4i4<4i4><X4>4>4>4>4>4i4'*4<4<4<4<*  SUBROUTINE  BRFTT  ’^********************************* 

^  4i  4<  *  4i  4<  4>  41 41  <X  4>  4<  *  4>  4>  *  4>  *  *  4>  *  <l>  If  4<  *  *  >l«>  4"X  *  *  *  <X  *  4>  *  *  <l>  4tiX  4<  4i  4' 4<  4<  4<  4i  4>  4>  4<  4i  4<  *  4i  4i  4i  4i  4>  4i  4<  4<  4»X  4<  4>  4<  4<  >l>  4> 


SUBROUTINE  BRFFT  (Al.  IFLAG) 


^  4i  4i  4i  4i  4i  41*  4i «  4>  4i  4>  4<  4i  4i  *  4<  4i  4>  4<  4i  4>  4i  4>  4>  4i  4>  4<  4i  4<  4<  4i  4<  4i  *  4i  4i  *  4>  4<  4i  4i  4«X  4i  4i  41 4t  4i  4i  4<  4i  4<  4i  4i  4i  4i  4i  4i  4i<X  4>  4>  <X  4>  4>  4>  4<  4i  4< 


C**********  FAST  FOURIER  TRANSFORM  ROUTINE  PROVIDED  BY  F.  ROBBINS  ***** 
C**********  FFT  RESULTS  STORED  IN  THE  GRAPHICS  FILE  IF  USER  SELECTED  ** 


^  4<  4«X  *  4«X  *  4i  4i  4i  4<  4i  41*  <X  4>  4<  4>  4<  4<  4>  4<  4<  4<  4<  4<  4>  4i  4i  4i  4< «  4<  4>  4i  4<  4i  4i  4<  4i  iX  4' 4<  4>  4<  4<  4>  4>  4>  4>  4>  4i  4<  4i  4i  4i  4i  *  4<  4<  4>  4<  4<  4>  4<  4<  4<  4<  4<  4< 


COMPLEX  A  (1024) 

DIMENSION  DATA  (1024,  3) 

DIMENSION  FREQ  (1024),  RMAG  (1024) 

CHARACTER*20  FILNAM,  XAXISL,  YAXISL,  Al  (20) 
CHARACTER*40  TITLE 
DIMENSION  B  (1024) 

DIMENSION  C  (1024) 

DIMENSION  D  (1024) 

EQUIVALENCE  (DATA  (1.  1),  B  (1)).  (DATA  (1.  3).  C  (1).  RMAG  (1)) 
EQUIVALENCE  (DATA  (1,  2).  D  (1)) 

PI  =  3.1415926535 


^  4>  41 4i  4i  *  4' 4i  4<  4i  4>  *  *  *  *  4i  4>  *  4i  4i  4>  4<  4i  4i  4' 4i  4i  iX  4<  4<  4i  4<  4<  41 IX  *  *  >X  4>  4' 4<  4i  *  4>  4i  4i  4i  4i  4<  4i  4>  4i  4>  4>  4<  4>  4r  4t  4>  >X  4<  4' 4>  4i  4i  4>  4>  4>  4>  4>  4i 


(;<4i**4.**«4i****4.4i4i4i4i*  OBTAIN  PRINTER  &  SCREEN  CHARACTERISTICS  4i4.4.4.*4.4.*4.4.4.4i 

^  4i  *  41 4i  4i  4i  4i  4i  4i  *  4i  4i  4iiX  4i  4i  iX  4i  41  *  iX  41  *  41 41 4<  4i  4i  4<  *  4<  41 IX  41 4i  4<  41 4>  4i  4i  *  4i  4i  *  4<  *  4i  4i  4<  >X  iX  iX  4>  IX  iX  >X  IX IX  4>  IX  4i  4i  4<  4>  4<  41 4<  4<  4i  41 4< 


CALL  CLEAR 
WRITE  (*,  6000) 

6000  FORMAT(//,10X,’This  program  has  the  capability  of  generating’, 
l/,10X,’hard  copy  plots  of  the  pressure-bum  rate  data.  To’, 

2/,  1  OX, ’generate  plots  information  concerning  your  printer  is', 
3/,10X, ’required.  The  output  port  is  assumed  to  be  LPTl,’, 

4//,  1  OX, ’Select  printer  by  number.’, 

5/,1.5X,’l.  Epson  Dot  Matrix’, 

6/,15X,’2.  HP  Laser  Jet  ’y/,10X,’Enter  Choice.’) 

READ  (*,  *)  NAIS 
IF  (NAIS  .EQ.  1)  THEN 
MODEL  =  5 
ELSE 

MODEL  =  62 
END  IF 


Q  4i  4i  41 4i  4i  41 41 4i  4i  4iiX  iX  iX  iX  iX  4i  iX  4i  4i  IX  4i  41 4i  41 IX  4i  41 4i  IX  4i  iX  4i  41 4i  4i  41 41 4i  41 41 41 4i  4i  41 4i  41 4i  4i  ■!<  4i  4i  X  4i  *  4i  4i  4i  iX  iX  iX  IX  41 4i  4i  iX  IX IX IX  4i  4<  4i 

(^xxxxxxxxxxxxxxxxxxx  read  PRESSURE  &  RATE  FROM  GRAPHICS  FILE  4.**x******* 


OPEN  (UNIT  =  14,  FILE  =  Al  (17)) 
J  =  0 


1000  CONTINUE 

READ  (14,  *,  END  =  1010)  P,  DXDT,  DPDT 
J  =  J  +  1 

IF  (P  .LT.  7.)  GO  TO  1000 
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JP7  =  J 
PMAX  =  P 
1020  CONTINUE 

READ  (14,  *,  END  =  1010)  P.  DXDT,  DPDT 
J  =  J-f  1 

IF  (P  .GT.  PMAX)  THEN 
PMAX  =  P 
JPMAX  =  J 
END  IF 
GO  TO  1020 
1010  CONTINUE 
JTOTAL  =  J 
REWIND  (UNIT  =  14) 

NPT7PM  =  JPMAX  -  JP7  +  1 

M  =  INT  (ALOG  (REAL  (NPT7PM))/ALOG  (2.0)  +  l.OE-10) 

N  =  M  +  1 
M  =  N 

NPT  =  2.0*'^N+  l.OE-10 
N  =  NPT 

IF  (nOTAL  .GT.  0.1*NPT7PM  +  JPMAX)  JTOTAL  =  PMAX  +  0.1*NPT7PM 
IF  (JTOTAL  .GE.  NPT)  THEN 
IF  (JTOTAL  .EQ.  NPT)  GO  TO  1030 
DO  1040  I  =  1.  JTOTAL  -  NPT 
READ  (14,  ♦)  P,  DXDT,  DPDT 
1040  CONTINUE 
1030  CONTINUE 

DO  10501  =  1,  NPT 
READ  (14,  *)  P,  DXDT,  DPDT 
DATA  a.  1)  =  P 
DATA  (I,  2)  =  DXDT 
DATA  (I,  3)  =  DPDT 
A  a)  =  CMPLX  (DXDT,  0.0) 

1050  CONTINUE 
ELSE 
J  =  0 

READ  (14,  •)  P,  DXDT,  DPDT 
DO  1060  I  =  1,  NPT  -  JTOTAL  +  1 
A  a)  =  CMPLX  (DXDT,  0.0) 

J  =  J+  1 
DATA  a.  1)  =  P 
DATA  a,  2)  =  DXDT 
DATA  a.  3)  =  DPDT 
1060  CONTINUE 

DO  1070  1=  1,  JTOTAL  -  1 
READ  (14,  *)  P,  DXDT,  DPDT 
DATA  (J  +  I,  1)  =  P 
DATA  (J  +  I,  2)  =  DXDT 
DATA  (J  +  I,  3)  =  DPDT 
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A  (J  +  I)  =  CMPLX  (DXDT,  0.0) 

1070  CONTINUE 
END  IF 

CLOSE  (UNIT  =  14) 

C*********  ATTEMPT  TO  BY  PASS  THE  FILTERING  TO  GET  PLOT  ******* 
IF  (IFLAG  .EQ.  1)  GO  TO  1080 
C  GET  FILTERING  WINDOW 

CALL  FFT  (A.  M.  NPT,  -  1.0,  2.0/REAL  (NPT)) 

NX  =  0 

DO  10901  =  l.N/2 
FREQ  a)  =  real  (I  -  1)/REAL  (N) 

IF  (FREQ  a)  .LE.  FMAX)  NX  =  NX  +  1 
1090  CONTINUE 
DO  11001=  l.N/2 

RMAG  (I)  =  SQRT  (REAL  (A  (I))**2  +  AIMAG  (A  (1))**2) 

1100  CONTINUE 

XAXISL  =  ’  FREQ(Hz)' 

YAXISL  =  ’  MAGNITUDE’ 

TITLE  =  ’  FFT  SPECTRUM’ 

CALL  PL88P  (FREQ.  RMAG.  N/2.  XAXISL.  YAXISL.  TITLE,  MODEL) 
WRITE  (*,  *)  ’INPUT  CUT  OFF  FREQUENCY  FOR  LOW  PASS  FILTER’ 
READ  (♦.  *)  FMAX 
DO  11101  =  l.N/2 
IF  (FREQ  (I)  .GE.  FMAX)  THEN 
IM  =  N  •  I  +  2 
A  (I)  =  CMPLX  (0.0.  0.0) 

A  OM)  =  CMPLX  (0.0.  0.0) 

END  IF 

1110  CONTINUE 

CALL  FFT  (A.  M,  NPT,  1.0,  0.5) 

1080  CONTINUE 

WRITE  (*,  *)  ’INPUT  PLOT  OPTION  DESIRED’ 

WRITE  (*,  *)  ’1.  PLOT  ORIGINAL  DATA’ 

WRITE  (*,  *)  ’2.  PLOT  FILTERED  DAl’A’ 

WRITE  (*,  •)  ’3.  OVERPLOT  ORIGINAL  AND  FILTERED  DATA’ 

WRITE  (*,  *)  ’4.  SELECT  DATA  SET  FOR  BURN  RATE  L  AWS  AND  EXIT’ 
READ  (*.  *)  lOPT 
IF  GOPT  .EQ.  4)  GO  TO  1120 
IF  GOPT  .EQ.  1)  GO  TO  1130 
IF  GOPT  .EQ.  2)  GO  TO  1140 
IF  GOPT  .EQ.  3)  GO  TO  1150 
1150  CONTINUE 
DO  11601  =  l.NPT 
C  (I)  =  REAL  (A  (D) 

IF  (B  (I)  .LT.  0.0)  B  (I)  =  -  B  (I) 

IF  (B  G)  .LE.  0.1)  B  (I)  =  .1001 
IF  (C  G)  .LT.  0.0)  C  (I)  =  -  C  (I) 

IF  (C  G)  .LE.  0.1)  C  (I)  =  .1001 
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IF  (D  a)  LT.  0.0)  D  (1)  =  -  D  (I) 

IF(D  a)  LE.  0.1)  D  (I)  =  .1001 
1160  CONTINUE 

XAXISL  =  ’PRESSURE  (MPa)’ 

YAXISL  «  ’BURNING  RATE  (cm/s)’ 

TITLE  =  ’BURNING  RATE  PLOT  ’//Al  (10) 

CALL  PL880P  (B.  C.  D,  NPT,  XAXISL.  YAXISL,  TITLE,  MODEL) 

GO  TO  1080 
1130  CONTINUE 
DO  11701=  l.NPT 
IF  (B  0)  .LT.  0.0)  B  (I)  =  -  B  0) 

IF  (B  a)  LE.  0.1)  B  (I)  =  .1001 
IF  (D  0)  .LT.  0.0)  D  (I)  =  -  D  (I) 

IF  (D  a)  .LE.  0.1)  D  (I)  =  .1001 
1170  CONTINUE 

XAXISL  =  ’PRESSURE  (MPa)’ 

YAXISL  =  ’BURNING  RATE  (cm/s)’ 

TITLE  =  ’BURNING  RATE  PLOT  ’//Al  (10) 

CALL  PL88LG  (B,  D.  NPT,  XAXISL,  YAXISL,  TITLE,  MODEL) 

GO  TO  1080 
1140  CONTINUE 

DO  11801=  l.NPT 
C  (I)  =  REAL  (A  (D) 

IF  (B  0)  .LT.  0.0)  B  (I)  =  -  B  (I) 

IF  (B  a)  .LE.  0.1)  B  (I)  =  .1001 
IF  (C  (I)  .LT.  0.0)  C  (I)  =  -  C  (I) 

IF  (C  a)  .LE.  0.1)  C  (I)  =  .1001 
1180  CONTINUE 

XAXISL  =  ’PRESSURE  (MPa)’ 

YAXISL  =  ’BURNING  RATE  (cm/s)’ 

TITLE  =  ’BURNING  RATE  PLOT  ’//Al  (10) 

CALL  PL88LG  (B.  C.  NPT,  XAXISL,  YAXISL,  TITLE,  MODEL) 

GO  TO  1080 
1120  CONTINUE 
CALL  CLEAR 

C******  ATTEMPT  TO  GET  GRAPH  EVEN  WHEN  NO  RLTERING  IS  DONE  ******** 
IF  (IFLAG  .EQ.  1)  GO  TO  1 190 
WRITE  (*,  6010) 

6010  FORMAT(//,10X,’Select  the  data  set  to  be  utilized  in  computing’, 
l/,10X,’the  bum  rate  laws  and  for  the  graphics  file.’, 

2//,10X,’l.  Original  Data’y,10X,’2.  Filtered  Dau’//, 

310X,’Enter  Selection.’) 

READ  (*.  *)  ISELET 
IF  aSELET  .EQ.  2)  THF.N 
OPEN  (UNIT  =  14.  FILE  =  Al  (17)) 

REWIND  (UNIT  =  14) 

TEMPI  =  0.0 
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(^***4il«***»*ft«*  ppj-s  pack  extra  data  points  at  beginning  to  *♦♦♦***♦** 

^*****«4i*«««**«  FORCE  THE  NUMBER  OF  POINTS  TO  BE  A  MULTIPLE  ********** 

(;4i***4<*4.***4.***  OF  2,  NEED  TO  REMOVE  THOSE  EXTRA  POINTS  *************** 

0  *  <ti  *  4>  4i  *41  <t>  *  41  *  4i  4>  4i4i*  4i  *  ****  **■)■*  it<  <)■  <l<  <t<  <•>  4i  <•  4>  4>  **  Ik  **  4"t<  *  4>  4>  4>4>  >l>  >l>  4>4i**itii(<  4i  <)■  4i>l>  4>  >)»•■*  4<  **  4i 

DO  1200  J  =  2,  NPT 

DELTA  =  ABS  (DATA  (J.  1)  -  DATA  (J  -  1.  1)) 

IF  (DELTA  .GT.  .1)  THEN 
NSTART  =  J  -  1 
GO  TO  1210 
END  IF 

1200  CONTINUE 
NSTART  =  1 

1210  CONTINUE 

DO  1220  I  =  NSTART.  NPT 
TEMP  =  REAL  (A  (1)) 

IF  (TEMP  .LE,  0.1)  TEMP  =  .1 

WRITE  (14,  *)  DATA  (I.  1).  TEMP,  TEMPI 

1220  CONTINUE 

CLOSE  (UNIT  =  14) 

END  IF 

1190  CONTINUE 
RETURN 
END 

SUBROUTINE  FFT  (A.  M.  N.  SIGN,  SCALE) 

COMPLEX  A  (N),  U,  W,  T 

PI  =  3.1415926535 

N  =  2**M 

NV2  =  N/2 

NMl  =  N  -  1 

J=  1 

mc  =  o 

DO  10001  =  1,N  -  1 
ITK  =  ITK  +  1 
IF  (I  .GE.  J)  GO  TO  1010 
T  =  A  (J) 

A  (J)  =  A  0) 

Aa)  =  T 

1010  CONTINUE 
K  =  NV2 

1020  CONTINUE 

IF  (K  .GE.  J)  GO  TO  1000 
J  =  J-K 
K  =  K/2 
GO  TO  1020 
J  =  J  +  K 

1000  CONTINUE 

me  *0 

DO  1030  L=  1,M 
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LE  =  2**L 

LEI  =  LE/2 

U  =  CMPLX  (1.0,  0.0) 

W  =  CMPLX  (cos  (PI/LEl),  SIGN*sin  (PI/LEl)) 

DO  1030  J  =  1.  LEI 
DO  1040  I  =  J,  N.  LE 
me  =  ITK  +  1 
IP  =  I  +  LEI 
T  =  A  (IP)*U 
A  (IP)  =  A  (I)  -  T 
A  (I)  =  A  (I)  *  T 
1040  CONTINUE 
U  =  U*W 
1030  CONTINUE 
ITK  =  0 

DO  1050  I  =  1,  N 
A  a)  =  A  (I)*SCALE 

me  =  me  +  1 

1050  CONTINUE 
RETURN 
END 

SUBROUTINE  PL88P  (X.  Y,  NPTS,  XAXISH,  YAXISH,  TITLEH,  MODEL) 
DIMENSION  X  (1).  Y  (1) 

CHARACTER*20  XAXISH,  YAXISH 
CHARACTER*40  TITLEH 
CHARACTER*20  YAXISL 
CHARACrER*40  TITLE 
CHARAC1ER*20  XAXISL 

CHARACTER*!  TITA  (40),  XAXISA  (20),  YAXISA  (20) 

EQUIVALENCE  (TnA  (1),  TITLE),  (XAXISA  (1), 

1  XAXISL),  (YAXISA  (1),  YAXISL) 

XAXISL  =  XAXISH 
YAXISL  =  YAXISH 
TITLE  =  TITLEH 
DO  1000  I  =  1,  20 
KI  =  21  -  I 

IF  (XAXISA  (KI)  .NE.  ’  ’)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 
NXA  =  KI 
DO  1020  I  =  1,  20 
KI  =  21  - 1 

IF  (YAXISA  (KI)  .NE.  ’  ’)  GO  TO  1030 
1020  CONTINUE 
1030  CONTINUE 
NYAsKI 
DO  10401=  1,40 
KI  =  41  -  I 
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IF  OTTA  (KI)  ,NE.  ’  ’)  GO  TO  1050 
1040  CONTINUE 
1050  CONTINUE 
NTA  =  KI 
WRITE  (*,  6000) 

WRITE  (*.  6010) 

6010  FORMATCO  DO  YOU  WISH  TO  HAV-E  A  HARDCOPY?  (1  FOR  YES,  0  FOR  NO)’) 
READ  (*,  5000)  ICYN 
5000  FORMATGl) 

6000  FORMATCO  STRIKE  ENTER  WHEN  HNISHED  WITH  PLOT’) 

CALL  PLOTS  (0,  97,  97) 

CALL  FACTOR  (1.0) 

HT  =  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6,  HT,  TITLE,  0.,  NTA) 

CALL  SCALE  (X,  5.00,  NPTS,  1) 

CALL  SCALE  (Y,  5.00,  NPTS.  1) 

CALL  STAXIS  (.25.  .25.  .Ill,  .112,  2) 

CALL  AXIS  (0..  0..  XAXISL,  -  NXA,  5.00,  0..  XI 
(NPTS  +  1).  X  (NPTS  +  2)) 

CALL  STAXIS  (.25,  .25.  .Ill,  .112,  -  1) 

CALL  AXIS  (0.,  0.,  YAXISL,  NYA,  5.0,  90..  Y1 
(NPTS  +  1),  Y  (NPTS  +  2)) 

CALL  LINE  (X.  Y,  NPTS.  1.  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

C  REAr(*,310)CH 
C310  FORMAT(Al) 

IF  aCYN  ,EQ.  0)  GO  TO  1060 
CALL  PLOTS  (0,  1,  MODEL) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT.  5.6,  HT,  TITLE,  0.,  NTA) 

CALL  SCALE  (X,  5.00,  NPTS,  1) 

CALL  SCALE  (Y.  5.00,  NPTS,  1) 

CALL  STAXIS  (.25,  .25,  .111,  .112,  2) 

CALL  AXIS  (0..  0..  XAXISL,  -  NXA.  5.00,  0..  X  (NPTS  +  1).  X  (NPTS  +  2)) 

CALL  STAXIS  (.25,  .25.  .Ill,  .112,  -  1) 

CALL  AXIS  (0..  0..  YAXISL,  NYA,  5.0,  90.,  Y  (NPTS  +  1).  Y  (NPTS  +  2)) 

CALL  LINE  (X.  Y.  NPTS,  1.  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

1060  CONTINUE 
RETURN 
END 
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SUBROUTINE  PL88LG  (X.  Y.  NPTS,  XAXISH,  YAXISH,  TITLEH,  MODEL) 
DIMENSION  X  (1),  Y  (1) 

CHARACTER*20  XAXISH.  YAXISH 
CHARACTER*40  TITLEH 
CHARACTER*20  YAXISL 
CHARACTER*40  TITI.E 
CHARACTER*20  XAXISL 

CHARACTER*!  TITA  (40).  XAXISA  (20).  YAXISA  (20) 

EQUIVALENCE  (TITA  (1).  TITLE),  (XAXISA  (1). 

1  XAXISL).  (YAXISA  (1).  YAXISL) 

XAXISL  =  XAXISH 
YAXISL  =  YAXISH 
TITLE  =  TITLEH 
DO  10001=  1.20 
KI  =  21  -  I 

IF  (XAXISA  (KI)  .NE.  *  ’)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 
NXA  =  KI 
DO  1020  I  =  1,  20 
KI  =  21  -  I 

IF  (YAXISA  (KI)  .NE.  ’  ’)  GO  TO  1030 
1020  CONTINUE 
1030  CONTINUE 
NYA  =  KI 
DO  10401=  1.40 
KI  =  41  -  I 

IF  (TITA  (KI)  .NE.  ‘  ’)  GO  TO  1050 
1040  CONTINUE 
1050  CONTINUE 
NTA  =  KI 
WRITE  (*,  6000) 

WRITE  (*,  6010) 

6010  FORMATCO  DO  YOU  WISH  TO  HAVE  A  HARDCOPY?  (  1  FOR  YES.O  FOR  NO)’) 
READ  (*,  5000)  ICYN 
5000  FORMATOD 

6000  FORMATCO  STRIKE  ENTER  WHEN  FINISHED  WITH  PLOT’) 

CALL  PLOTS  (0.  97,  97) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  H'r*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6,  HT.  TITLE,  0..  NTA) 

CALL  SCALG  (X,  5.00,  NPTS,  1) 

CALL  SCALG  (Y,  5.00,  NPTS,  1) 

CALL  STAXIS  (.25.  .25.  .Ill,  .112,  2) 

CALL  LGAXS  (0..  0.,  XAXISL.  -  NXA,  5.00,  0..  X  (NPTS  +  1),  X  (NPTS  +  2)) 
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CALL  STAXIS  (.25.  .25.  .111.  .112.  -  1) 

CALL  LGAXS  (0..  0..  YAXISL.  NY  A.  5.0,  90..  Y  (NPTS  +  1).  Y  (NPTS  +  2)) 

CALL  LGLIN  (X.  Y.  NPTS.  1.  0.  0.  0) 

CALL  PLOT  (0.0.  0.0,  999) 

C  READ(*.310)CH 
C310  FORMAT(Al) 

IF  OCYN  .EQ.  0)  GO  TO  1060 
CALL  PLOTS  (0.  1.  MODEL) 

CALL  FACTOR  (1.0) 

HT  =  .25 

CALL  PLOT  (2.50.  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT.  5.6.  HT.  TITLE.  0..  NTA) 

CALL  SCALG  (X.  5.00.  NPTS.  1) 

CALL  SCALG  (Y.  5.00,  NPTS.  1) 

CALL  STAXIS  (.25.  .25.  .1 11.  .1 12,  2) 

CALL  LGAXS  (0..  0..  XAXISL.  -  NXA,  5.00,  0..  X  (NPTS  +  1).  X  (NPTS  +  2)) 

CALL  STAXIS  (.25.  .25.  .111.  .112,  -  1) 

CALL  LGAXS  (0..  0..  YAXISL.  NYA.  5.0,  90..  Y  O^PTS  +  1).  Y  (NPTS  +  2)) 

CALL  LGLIN  (X,  Y.  NPTS.  1.  0.  0,  0) 

CALL  PLOT  (0.0.  0.0,  999) 

1060  CONTINUE 
RETURN 
END 

SUBROUTINE  PL880P  (X.  Y.  Z.  NPTS,  XAXISH,  YAXISH.  TllXEM,  MODEL) 
DIMENSION  X  (1),  Y  (1),  Z  (1) 

CHARACTER*20  XAXISH.  YAXISH 
CHARACTER*40  TITLEH 
CHARACTER*20  YAXISL 
CHARACTER*40  TITLE 
CHARACTER*20  XAXISL 

CHARACTER*!  TITA  (40),  XAXISA  (20).  YAXISA  (20) 

EQUIVALENCE  (TITA  (1),  TITLE),  (XAXISA  (1).  XAXISL),  (YAXISA  (1),  YAXISL) 
XAXISL  =  XAXISH 
YAXISL  =  YAXISH 
TITLE  =  TITLEH 
DO  1000  I  =  1,  20 
KI  =  21  -  I 

IF  (XAXISA  (KI)  .NE.  ’  ’)  GO  TO  1010 
1000  CONTINUE 
1010  CONTINUE 
NXA  =  KI 
DO  1020  I  =  1.  20 
KI  =  21  - 1 
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IF  (YAXISA  (KI)  .NE.  ’  ’)  GO  TO  1030 
1020  CONTINUE 
1030  CONTINUE 
NYA  =  KI 
DO  10401=  1,40 
KI  =  41  -  I 

IF  (TITA  (KI)  .NE.  ’  ’)  GO  TO  1050 
1040  CONTINUE 
1050  CONTINUE 
NTA  =  KI 
WRITE  (*.  6000) 

WRITE  (*.  6010) 

6010  FORMATCO  DO  YOU  WISH  TO  HAVE  A  HARDCOPY?  (1  FOR  YES,  0  FOR  NO)’) 
READ  (*,  5000)  ICYN 
5000  FORMAT(Il) 

6000  FORMATCO  STRIKE  ENTER  WHEN  HNISHED  WITH  PLOT’) 

CALL  PLOTS  (0,  97,  97) 

CALL  FACTOR  (1.0) 

HT=  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  S'mBOL  (XT,  5.6,  HT,  TITLE.  0..  NTA) 

CALL  SCALG  (X.  5.00,  NPTS,  1) 

CALL  SCALG  (Y.  5.00,  NPTS.  1) 

CALL  SCALG  (Z.  5.00,  NPTS.  1) 


MAKE  SCALE  FOR  Y  &  Z  IDENTICAL  ****************** 


^  *  1)1  *  *  4(  *  Di  Hi  4>  *  Ik  4t  i|r  *  4r  Ik  iti  *  *  Id  Hi  *  *  4r  III  III  4t  4i  4c  *  Hi «  «  4i  *  «  *  i|c «  Hi  4c  !«■  umi  *  *  itt  i|c « itiif  *  *  *  4c  4i  i|i  4i  * 


START  =  MIN  (Y  (NPTS  +  1),  Z  (NPTS  +  1)) 

Y  (NPTS  +  1)  =  START 
Z  (NPTS  +  I)  =  START 

START  =  MAX  (Y  (NPTS  +  2),  Z  (NPTS  +  2)) 

Y  (NPTS  +  2)  =  START 
Z  (NPTS  +  2)  =  START 

CALL  STAXIS  (.25.  .25,  .111,  .112,  2) 

CALL  LGAXS  (0.,  0..  XAXISL,  -  NX  A,  5.00,  0..  X  (NPTS  +  1),  X  (NPTS  +  2)) 
CALL  STAXIS  (.25,  .25.  .Ill,  .112,  -  1) 

CALL  LGAXS  (0..  0..  YAXISL,  NYA,  5.0,  90..  Y  (NPTS  +  1).  Y  (NPTS  +  2)) 
CALL  LGLIN  (X.  Y.  NPTS,  1,  0.  0.  0) 

CALL  LGLIN  (X.  Z.  NPTS.  1,  0.  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

C  READ(*,310)CH 
C310  FORMAT(Al) 

IF  GCYN  .EQ.  0)  GO  TO  1060 
CALL  PLOTS  (0.  1.  MODEL) 

CALL  FACTOR  (1.0) 
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HT  =  .25 

CALL  PLOT  (2.50,  1.50,  -  3) 

XT  =  2.5  -  HT*5./8.*.5*NTA 

CALL  SYMBOL  (XT,  5.6,  HT,  TITLE,  0.,  NTA) 

CALL  SCALG  (X,  5.00,  NPTS,  1) 

CALL  SCALG  (Y.  5.00,  NPTS,  1) 

CALL  SCALG  (Z,  5.00,  NPTS,  1) 

CALL  ST  AXIS  (.25.  .25.  .Ill,  .112,  2) 

CALL  LGAXS  (0..  0..  XAXISL,  -  NX  A.  5.00,  0..  X  (NPTS  +  1).  X  (NPTS  +  2)) 
CALL  STAXIS  (.25,  .25,  .111,  .112,  -  1) 

CALL  LGAXS  (0.,  0..  YAXISL,  NYA,  5.0,  90..  Y  (NPTS  +  1),  Y  (NPTS  +  2)) 
CALL  LGLIN  (X,  Y.  NPTS.  1,  0.  0,  0) 

CALL  LGLIN  (X.  Z,  NPTS.  1,  0.  0.  0) 

CALL  PLOT  (0.0,  0.0,  999) 

1060  CONTIN  UE 
RETURN 
END 

^  %  *  *  «  4i «  41*  *  *  *  *  « III  *  4<  *  4<  *  4> «  *  *  »<  *  *  *  4>  it>  *<  <<  *  «  4, «  *  «  « III  « >|c  *  «  «  4<  *  *  ■!• 

^4i4i4i4<4i4i4i4i4iik4iil<il>4i«4<4<4i4i4i4i  BRNRT  <)"*■ ’*"4"*' * 4"*"* 

Q  4<  4<  *  4>  41 4»l>  4i  4i  *  4i  *  4i  4i «  4i  4<  it<  4<  4i  *  111  4i  *  4<  4i  4<  *  4i  4i  4<  4<  4<  *  4i  4i  4<  4i  4< «  4i  111  111  III  111  4i  4<  4i  *  4i  4<  4<  41 4<  4<  4>  4i  4>  4>  4i  4<  4i  4i  4i  4<  *  *  4<  * 

SUBROUTINE  BRNRT  (Al.  lOUTCH) 

^  4, 4, 4, 4, 4,  4i  4, 4, 4i  4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4i  4i  4, 4,  ^  4i  4, 4, 4i  4i  4i  4i  4i  4i  4, 4i  4, 4i  4i  4,41 4i  4i  4i  4, 4, 4i  4i  4i  4i  4i  4i  4i  4i  4i  4, 4i  4, 4, 4, 4i  4i  4, 4i  4, 4i  4, 4, 4, 


C  PROVIDED  BY  F.  ROBBINS;  12/28/91 
C  MODIFIED  BY  W.  OBERLE;  12/28/91 
C  NOW  CALCULATE  LEAST  SQUARES  FIT  OF  DXDT=A*PAN 
C  OVER  PRESSiniE  RANGE  PLOW  TO  PHIGH  FOR  AS  MANY 
C  RANGES  AS  REQUIRED 


^  Hi  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  Hi  4i  *  4i  4i  4i  4i  4i  4i  4i  Hi  *  4i  4i  4i  4i  4i  m  4i  Hi  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  Hi 


CHARACTER*20  Al  (20) 

DIMENSION  XRATES  (100,  5).  PRE  (1024),  RT  (1024) 


^  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4<  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  41 4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 

(>4i*4i4.4.4i4i4<4i«***4i4i4.*4i4<  piRST  THE  PREDETERMINED  RATES  ARE  LISTED  ********* 
^  4i  4i  4i  4i  4i  4i  4i4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  Hi  4i  4i  4i  4i  4i  4i  4i  1i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  m  4i  4i  4i  41 4i  4i  4i  4i  4i  4i  4i  *  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i  4i 


OPEN  (UNIT  =  5.  FILE  =  Al  (18)) 

READ  (5.  *)  NN 
DO  10001=  1,NN 
READ  (5,  *)  XRATES  (I,  1) 

READ  (5,  *)  XRATES  (I,  2) 

READ  (5.  *)  DUMMY 
READ  (5.  *)  DUMMY 
READ  (5,  *)  DUMMY 
1000  CONTINUE 
CLOSE  (UNIT  =  5) 

IF  ((lOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6000) 

END  IF 
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IF  (aOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2,  6000) 

END  IF 

6000  FORMATC’lMOX.’Table  of  Bum  Rate  Laws’//) 

1010  CONTINUE 
CALL  CLEAR 
WRITE  (*.  6010) 

6010  FORMAT(//,10X,'The  current  pressure  regions  over  which  the’, 
l/,10X,’bum  rate  laws  will  be  computed  are  given  below.’, 

2/,  1  OX , ’Pressure ’,  1  OX, ’Pressure  ’ /) 

DO  1020  I  =  1,  NN 

WRITE  (*,  6020)  XRATES  (I,  1),  XRATES  0.  2) 

1020  CONTINUE 
6020  FORMATC  ’,2F18.4) 

1030  CONTINUE 
WRITE  (*,  6030) 

6030  FORMAT(//,’  DO  YOU  WANT  TO  ADD  ANOTHER  PRESSURE  RANGE’, 

1/,  ’  FOR  BURN  RATE  CALCULATION?  (Yes=l,  No=2)’) 

READ  (*.  5000)  ICYN 
5000  FORMAT(Il) 

IF  aCYN  .EQ.  2)  GO  TO  1040 
CALL  CLEAR 
WRITE  (•.  6040) 

6040  FORMAT(’  ENTER  LOW  AND  HIGH  PRESSURES:  (MPA)  ’) 

READ  (*.  •)  PLOW,  PHIGH 
NN»NN+  1 
XRATES  (NN,  1)  =  PLOW 
XRATES  (NN,  2)  =  PHIGH 
GO  TO  1010 
1040  CONTINUE 

^4i4<*4r4i4i4i4i4i4i4i«i4i4r4r4i4i***4iik4>4i4'4>4'4i*4i4i4i4i*«*«*4>4<4>**4>4i4i«4i**«4i4>4^i|i4iit<4<iti4i«4i«4>*4i4iiti*4i 

HEADINGS  ARE  WRITTEN  ****************************** 

IF  (OOUTCH  .EQ.  1)  .OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7,  6050) 

END  IF 

IF  ((lOUTCH  .EQ.  2)  .OR.  (lOUTCH  .EQ.  3)1  THEN 
WRITE  (2.  6050) 

END  IF 

6050  FORMAT(’  ’,8X,’RANGE’/7X,’PLOW  PHIGH’,9X,’COEF’,12X, 

1  •EXP’,8X,’CORR  COEF’/8X,’MPA’.4X,’MPA’,7X,’CM/S-MPA'^EXP’, 

2  9X.’-’.13X.’-’/) 

(;«******•***•«**»*«  GRAPHICS  FILE  OPENED  &  READ  ****•-»■**♦**•*•*•***•*** 

0**«i»*«*«**i(i*«i«r4i«i****«*4i*«4i*4r***«******«i4i**4ii»«,W4i4i*««4i***4i*4i**«*«itr«(i*««« 

OPEN  (UNIT  =  4.  FILE  =  A1  (17),  STATUS  =  ’OLD’) 

REWIND  (UNIT  =  4) 

JJ«  1 
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1050  CONTINUE 

READ  (4,  *,  END  =  1060)  PRE  (JJ).  RT  (JJ),  XXX 
JJ  =  JJ  +  1 
GO  TO  1050 
1060  CONTINUE 
CLOSE  (UNIT  =  4) 

JJ  =  JJ  -  1 


LAWS  ARE  COMPUTED  ***************************** 

DO  10701  =  1,NN 
NLOW=  1 
NHIGH  =  JJ 


PLOW  =  XRATES  a.  1) 

PHIGH  =  XRATES  (I,  2) 

DO  1080  K  =  1,  JJ 
IF  (PRE  (K)  .GE.  PLOW)  THEN 
NLOW  =  K 


GO  TO  1090 
END  IF 

1080  CONTINUE 

WRITE  (*.  •)  •  NO  PRESSURE  ABOVE;  PLOW 
WRITE  (*,  *)  ’  WILL  GO  TO  NEXT  STEP* 
PAUSE 
GO  TO  1070 
1090  CONTINUE 

DO  1100  K  =  NLOW  +  1.  JJ 
IF  (PRE  (K)  .GT.  PHIGH)  THEN 
NHIGH  =  K  •  1 
GOTO  1110 
END  IF 

1100  CONTINUE 
NHIGH  =  JJ 
1110  CONTINUE 
A7  =  0. 

A8*0. 

A9  =  0. 

H5»0. 

Hg»0. 

H9**0. 

DO  1120  K  »  NLOW.  NHIGH 
P  =  PRE  (K) 

DXDT  *  RT  (K) 

A7  «  A7  +  ALOGIO  (P) 

A8  ■  A8  +  ALOGIO  (P)* ALOGIO  (P) 

A9  «  A9  +  ALOGIO  (P)* ALOGIO  (DXDT) 

H5  «  H5  +  ALOGIO  (DXDT) 

H8  =  H8  +  ALOGIO  (DXDT)* ALOGIO  (DXDT) 
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H9  =  H9  +  1 
1120  CONTINUE 

B5  =  (A8*H5  -  A7*A9)/(H9*A8  -  A7*A7) 

B6  =  (H9*A9  -  A7*H5)/(H9*A8  -  A7*A7) 

B5  =  10.**B5 

R6  =  (H9*A9  -  H5*A7)/SQRT  ((H9*A8  -  A7*A7)*(H9*H8  -  H5*H5)) 

XRATES  (I,  3)  =  B5 
XRATES  (I.  4)  =  B6 
XRATES  a.  5)  =  R6 

IF  ((lOUTCH  .EQ.  1)  OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (7.  6060)  PLOW.  PHIGH.  B5.  B6.  R6 
END  IF 

IF  ((lOUTCH  .EQ.  2)  OR.  (lOUTCH  .EQ.  3))  THEN 
WRITE  (2.  6060)  PLOW.  PHIGH.  B5.  B6.  R6 
END  IF 

C460  CONTINUE 
1070  CONTINUE 

6060FORMAT(4Xp7.0.1X.F7.0.5X.E12.6.5X.F9.6.5X,F9.6) 

^t****************  WRITING  BURN  RATE  FILE  ***************************** 

•*••*«************** *****4<** ************************ **************** 

OPEN  aiNTT  =  4.  RLE  =  A1  (18)) 

REWIND  (UNIT  =  4) 

WRITE  (4.  •)  NN 
DO  1130  I  1.  NN 
WRITE  (4.  •)  XRATES  (I.  1) 

WRITE  (4.  •)  XRATES  (1.  2) 

WRITE  (4.  •)  XRATES  (I.  3) 

WRITE  (4.  •)  XRATES  (I,  4) 

WRITE  (4.  *)  XRATES  (I.  5) 

11 30  CONTINUE 
CLOSE  (UNIT  =  4) 

RETURN 

END 
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Intentionally  left  blank. 
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APPENDIX  M: 

SMOOTHING  AND  DIFFERENTIATION  COEFFIOENTS 


Intentionally  left  blank. 
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SMOOTHING  COEFFICIENTS 


BRIDGE  LENGTH;  N  =  5 

-8.57 142857 1428E-02 

3.428571428571E-01 

4.857142857143E-01 

3.42857142857IE-01 

-8.571428571428E-02 


BRIDGE  LENGTH:  N  =  7 

-9.523809523809E-02 

1.428571428571E-01 

2.857142857143E.01 

3.333333333333E-01 

2.857142857143E-01 

1.428571428571E-0i 

-9,523809523809E-02 

BRIDGE  LENGTH:  N  =  9 


-9.090909090909E-02 
6.060606060606E-02 
1.68831 1688312E-01 
2.337662337662E-01 
2.5541 125541 13E-01 
2.337662337662E-01 
1.68831 1688312E-01 
6.060606060606E-02 
-9.090909C90909E-02 

BRIDGE  LENGTH:  N  =  11 

-8.391608391608E-02 

2.097902097902E-02 

1.025641025641E-01 

1.608391608392E-01 

1.958041938042E-01 

2.074592074592E-01 

1. 95804 1958042E-01 

1.608391608392E-01 

1.025641025641E-01 

2.097902097902E-02 

-8.391603391608E-02 
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BRIDGE  LENGTH:  N  =  13 


-7.692307692307E-02 

8.881784197001E16 

6.293706293706E-O2 

1.1 18881 118881E-01 

1.468531468531E-01 

1.678321678322E-01 

1.74825 1748252E-01 

1.678321678322E-01 

1.46853 146853  lE-01 

1.1188811 18881E-01 

6.293706293706E-02 

8.881784197(X)1E-16 

-7.692307692307E-02 


BRIDGE  LENGTH:  N  =  15 

-7.05882352941  lE-02 

-1.176470588235E-02 

3.8(X)904977376E-02 

7.873303167421E-02 

1.104072398190E-01 

1.330316742081E-01 

1.466063348416E-01 

1.511312217195E-01 

1.466063348416E-01 

L330316742081E-01 

1.104072398190E-01 

7.8733031 6742  lE-02 

3.800904977376E-02 

-1.176470588235E-02 

-7.05882352941  lE-02 

BRIDGE  LENGTH:  N  =  17 

-6.501547987616E-02 

-1.857585139319E-02 

2.167182662539E-02 

5.572755417957E-02 

8.359133126935E-02 

1. 05263 1578947E-01 

1.207430340557E-01 

1.300309597523E-01 

1.331269349845E-01 

1.300309597523E-01 

1.207430340557E-01 
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1.052631578947E-01 
8.359133126935E-02 
5.572755417957E-02 
2.167182662539E-02 
- 1.8575851 393 19E-02 
-6.501 54798761 6E-02 

BRIDGE  LENGTH:  N  =  19 

-6.015037593985E-02 

-2.255639097744E-02 

1.061477222468E-02 

3.93631 1366652E-02 

6.368863334808E-02 

8.359133126935E-02 

9.907120743034E-02 

1.101282618310E-01 

1.167624944715E-01 

1.189739053516E-01 

1.167624944715E-01 

1.101282618310E-01 

9.907120743034E-02 

8.359133126935E-02 

6.368863334808E-O2 

3.93631 1366652E.02 

1.061477222468E-02 

-2.255639097744E-02 

-6.015037593985E-02 

BRIDGE  LENGTH:  N  =  21 

-5.5900621 11801E-02 

-2.484472049689E-02 

2.942 137953580E-03 

2.74599542334 lE-02 

4.870872834260E-02 

6.6688460281 14E-02 

8.139915004904E-02 

9.284079764629E-02 

1.010134030729E-01 

1.059I69663289E-01 

1.0755 14874 142E-01 

1.059169663289E-01 

1.010134030729E-01 

9.284079764629E-02 

8.139915004904E-02 

6.6688460281 14E-02 

4.870872834260E-02 


2.74599542334 lE-02 
2.942137953580E-03 
-2.484472049689E-02 
-5.5900621 11801E-02 

BRIDGE  LENGTH:  N  =  23 

-5.217391304348E-02 

-2.608695652174E-02 

-2.484472049689E-03 

1.863354037267E-02 

3.726708074534E-02 

5.341614906832E-02 

6.708074534161E-02 

7.826086956522E-02 

8.695652173913E-02 

9.316770186335E-02 

9.689440993789E-02 

9.813664596273E-02 

9.689440993789E-02 

9.3 167701 86335E-02 

8.695652173913E-02 

7.826086956522E-02 

6.708074534161E-02 

5.341 614906832E-02 

3.726708074534E-02 

1.863354037267E-02 

-2.484472049689E-03 

-2.608695652174E-02 

-5.217391304348E-02 

BRIDGE  LENGTH:  N  =  25 

-4.888888888889E-02 
-2.666666666667E-02 
-6.3768 11594202E-03 
1.198067632850E-02 
2.8405797 10145E-02 
4.289855072464E-02 
5.545893719807E-02 
6.608695652174E-02 
7.478260869565E-02 
8.154589371981E-02 
8.637681 159420E-02 
8.92753623 1884E-02 
9.024 154589372E-02 
8.927536231 884E-02 
8.637681 159420E-02 


8.i54589371981E-02 

7.478260869565E-02 

6.6O8695652174E-02 

5.545893719807E-O2 

4.289855072464E-02 

2.840579710145E-02 

IJ98067632850E-02 

-6.37681 1594202E-03 

-2.666666666667E-02 

-4.888888888889E-02 

BRIDGE  LENGTH:  N  =  27 

-4.597701 149425E-02 

-2.681992337165E-02 

-9.195402298849E-03 

6.896551724139E-03 

2.145593869732E-02 

3.448275862069E-02 

4.597701 149425E-02 

5.593869731801E-02 

6.43678 1609195E-02 

7.126436781609E-02 

7.662835249042E-02 

8.04597701 1494E-02 

8.275862068965E-02 

8.35249042 1456E-02 

8.275862068965E-02 

8.04597701 1494E-02 

7.662835249042E-02 

7.126436781609E-02 

6.436781 609 195E-02 

5.593869731801E-02 

4.597701 149425E-02 

3.448275862069E-02 

2.145593869732E-02 

6.896551724139E-03 

-9.195402298849E-03 

-2.681992337165E-02 

-4.597701 149425E-02 

BRIDGE  LENGTH:  N  =  29 

-4.338153503893E-02 
-2.669632925473E-02 
-1.124706463972E-02 
2.966258806081E-03 
1. 594364 108268E-02 


2.768508219009E-02 

3.819058212829E-02 

4.746014089729E-02 

5.549375849709E-02 

6.229143492770E-02 

6.785317018910E-02 

7,2 17896428 130E-02 

7.526881720430E-02 

7.712272895810E-02 

7.774069954270E-02 

7.712272895810E-02 

7.526881720430E-02 

7.217896428130E-02 

6.7853 1701 8910E-02 

6.229143492770E-02 

5.549375849709E-02 

4.746014089729E-02 

3.819058212829E-02 

2.768508219009E-02 

1. 594364 108268E-02 

2.96625880608  lE-03 

■1.124706463972E-02 

-2.669632925473E-02 

-4.338 153503893E-02 

BRIDGE  LENGTH:  N  =  31 

-4.105571847507E-02 

-2.6392961 87683E.02 

- 1.274 142987 157E-02 

-1.011224592977E-04 

1.152796036000E-02 

2.214581858631E-02 

3.1752452219e4E-02 

4.034786125999E-02 

4.793204570735E-02 

5.450500556173E-02 

6.0066740823 14E-02 

6.461725149156E-02 

6.815653756699E-02 

7.068459904945E-02 

7.220143593892E-02 

7.27070482354  lE-02 

7.220143593892E-02 

7.0684599O4945E-O2 

6.815653756699E-02 

6.461725149156E-02 

6.006674082314E-02 
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5.450500556173E-02 

4.793204570735E-02 

4.034786125999E-02 

3.175245221964E-02 

2.214581858631E-02 

1.152796036000E-02 

-1.011224592977E-04 

-1.274142987157E-02 

-2.639296187683E-02 

-4.105571847507E-02 

BRIDGE  LENGTH;  N  =  33 

-3.896103896104E-02 

-2.597402597403E-02 

-1.382488479263E-02 

-2.5 136 1541 684  lE-03 

7.959782153331E-03 

1.759530791789E-02 

2.639296187683E-02 

3.435274403016E-02 

4.147465437788E-02 

4.775869291998E-02 

5.320485965647E-02 

5.781315458735E-02 

6.158357771261E-02 

6.451612903226E-02 

6.661080854629E-02 

6.786761625471E-02 

6.8286552 15752E-02 

6.786761625471E-02 

6.661080854629E-02 

6.451612903226E-02 

6.158357771261E-02 

5.781315458735E-02 

5.320485965647E-02 

4.775869291998E-02 

4.147465437788E-02 

3.435274403016E-02 

2.639296187683E-02 

1.759530791789E-02 

7.959782153331E-03 

.2.513615416841E-03 

.1.382488479263E-02 

.2.597402597403E-02 

-3.896103896104E-02 


BRIDGE  LENGTH:  N  =  35 


-3.706563706564E-02 

-2.548262548263E-02 

-1.460161460161E-02 

-4.422604422604E-03 

5.054405054405E-03 

1.382941382941E-02 

2.190242190242E-02 

2.927342927343E-02 

3.594243594244E-02 

4.190944190944E-02 

4.717444717445E-02 

5.173745173745E-02 

5.559845559846E-02 

5.875745875746E-02 

6.121446121446E-02 

6.296946296946E-02 

6.402246402246E-02 

6.437346437346E-02 

6.402246402246E-02 

6.296946296946E-02 

6.121446121446E-02 

5.875745875746E-02 

5.559845559846E-02 

5.173745173745E-02 

4.717444717445E-02 

4. 190944 190944E-02 

3.594243594244E-02 

2.927342927343E-02 

2.190242I90242E4)2 

1.382941 38294  lE-02 

5.054405054405E-03 

-4.4226O44226O4E-03 

-1.460161460161E-02 

-2.548262548263E-02 

-3.706563706564E-02 


DIFFERENTIATION  COEFFICIENTS 


BRIDGE  LENGTH:  N  =  5 


-2.0000000000(X)E-01 

-l.OOOOOOOOOOOOE-01 

0.0 

l.OOOOOOOOOOOOE-01 

2.000000000000E-01 


386 


BRIDGE  LENGTH:  N  =  7 


-1.071428571429E-01 

-7.142857142857E-02 

-3.571428571429E-02 

0.0 

3.57142857 1429E-02 
7.142857142857E-02 
1.071428571429E-01 


BRIDGE  LENGTH:  N  =  9 
.6.666666666667E-02 


'rrrrrriTriTC 


-3.333333333333E-02 

-1.666666666667E-02 

0.0 

I,666666666667E-02 

3.333333333333E^2 


TnTmYmV 


6.666666666667E-02 

BRIDGE  LENGTH:  N  =  11 

-4.545454545455E-02 

-3.636363636364E-02 

-2.727272727273E-02 

-1.81&1818181g2E-02 

-9.090909090909E-03 

0.0 

9.090909090909E-03 

1.818181818182E-02 

ininiiminE-Qi 

3.636363636364E-02 

4.545454545455E-02 


BRIDGE  LENGTH:  N  =  13 

-3.296703296703E-02 
-2.747252747253E-02 
-2. 197802 197802E-02 
-1.648351648352E-02 
-1.098901098901E-02 
'S.494S05494S05E-03 
0.0 

5 494505494505E-03 
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1.098901098901E-02 

1.648351648352E-02 

2.197802197802E-02 

2.747252747253E-02 

3.296703296703E-02 

BRIDGE  LENGTH:  N  =  15 


-2,142857142857E-02 

-1.785714285714E-02 

-1.428571428571E-02 

-1.071428571429E-02 

-7.142857142857E-03 

-3.571428571429E-03 

0.0 

3.571428571429E-03 
7.142857142857E-03 
1.071428571429E-02 
1.428571428571E-02 
1.7857 142857 14E-02 
2.142857142857E-02 
2.500000000000E-02 

BRIDGE  LENGTH:  N  =  17 

-1. 9607843 13725E-02 
-L715686274510E-02 
-1.470588235294E-02 
-1.225490196078E-02 
-9.803921568627E-03 
-7.352941 176471E^3 
-4.9019007843 14E-03 
-2.450980392157E-03 
0.0 

2.450980392157E-03 
4.901960784314E-03 
7.352941 176471E-03 
9.80392 1568627E-03 
1.225490196078E-02 
1.470588235294E-O2 
1.7 156862745  lOE-02 
1.960784313725E-02 

BRIDGE  LENGTH:  N  =  19 

-L578947368421E-02 

-1.403508771930E-02 


-1.228070175439E-02 
-1. 05263 1578947E-02 
-8.771929824561E-03 
-7.017543859649E-03 
-5.263 157894737E-03 
-3.508771929825E-O3 
-1. 7543859649 12E-03 
0.0 

1. 7543859649 12E-03 
3.50877 1929825E-03 
5.263 157894737E -03 
7.017543859649E-03 
8.771929824361E-03 
1. 05263 1578947E4)2 
1.228070175439E-02 
1. 40350877 1930E -02 
1.57894736342  lE-02 


BRIDGE  LENGTH:  N  =  21 

- 1.298701 29870  lE-02 
•  M  6883 11 6883  lE-02 
-1.038961038961E-02 
.9.090909090909E-03 
-7.792207792.208E-03 
■6.493506493506E-03 
-5. 194805 194 805E-03 
-3.896103896104E-03 
-2.597402597403E03 
- 1.298701 298701 E-03 
0.0 

1.298701 298701  E-03 
2.59';402597403E^3 
3.S96l038%104E-03 
5  194805 194 g05E-03 
6.493506493506E-03 
7.792207792208E-C3 
9.090909090909E-03 
1.038961 03896  lE-02 
1.1 6883 116883  IE-02 
1.298701 29870  lE-02 

BRIDGE  LENGTH:  N  =  23 

-1. 08695652 1739E-02 
9.88I422924901E^3 
-8.893280632411  E-03 
-7.905 138339921  E-03 


-6.916996047431E-03 
-5.97885375494  lE-03 
4.9407 1146245  lE-03 
-3.952569169960E-03 
-2.964426877470E-03 
-1.976284584980E-03 
-9.88 1422924901 E-04 
0.0 

9.8814Z2924901E-04 
1.976284584980E.03 
2.9M426877470E-03 
3.952569169960E-03 
4.94071 146245  lE-03 
5.928853754941E-03 
6.916996047431E-03 
7.9051 3833992  lE-03 
8.89328063241  lE-03 
9.881422924901E-03 
1.086956521739E-02 

BRIDGE  LENGTH:  N  =  25 

-9.230769230769E-03 
-8.461538461538E-03 
-7.692307692308E-03 
-6.923076923077E-fl3 
-6.153846I53846E-03 
-5.38461 53846 15E-03 
4.6i5384615385E-03 
-3.846153846154E-03 
-3.076923076923E-03 
-2.307692307692E-03 
-1.538461538462E-03 
-7.692307692308E-04 
0.0 

7.692307692308E-04 

1.538461538462E-03 

2.307692307692E-03 

3.076923076923E-03 

3.846153846154E-03 

4.615384615385E-03 

5.384615384615E-03 

6.I53846i53846E-03 

6.923076923077E-03 

7.692307692308E-03 

8.461538461538E-03 

9.230769230769E-03 


BRIDGE  LENGTH:  N  »-  27 


-7.936507936508E-03 

-7.326007325007E-03 

-6.7155067JS.S07E-03 

-6.105006)05006E-03 

-5.494505494505E-03 

-4.884004884005E-03 

-4.273504273504E-03 

-3.663003663C04E-03 

-3.052503052503E-03 

-2.442002442002E-03 

-1.8315C18315C2E-03 

-1.221001221001E-03 

•6.105006IOS006E-04 

0.0 

6.105006105006E-04 

1.22100i22i001E-03 

1.831501831502E-03 

2.442002442002E-03 

3.052503052503E-03 

3.663003663004E-03 

4.273504272504E-03 

4.884004884005E-03 

5.494505494505E4)3 

6.105006105006E03 

6.715506715507E-03 

7.326007326007Ii-03 

7.936507936508E-03 

BRIDGE  LENGTH:  N  =  29 

-6.896551724138E-03 
-6.403940886699E-03 
-5.911330049261E-03 
-5.41871921 1823L-03 
-4.926108374384E-03 
-4.43349753694 6E-03 
-3.940886699507E-03 
-3.448275862069E-03 
-2.955665024631E-03 
-2.463054187192E-03 
-1.970443349754E-03 
-1.477832512315E-03 
-9.8522 16748768E-04 
-4.926108374384E-O4 
0.0 

4.92dl08374384E-04 
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9.85221<5748768E-04 
1.4778325 123 15E-03 
1.970443349754E-03 
2.463054187192E-03 
2.955665024631E-03 
3.448275862069E-03 
3.940886699507E-03 
4.433497536946E-03 
4.926108374384E-03 
5.41871921 1823E^3 
5,911330049261E-03 
6.403940886699E-03 
6.8%551724138E-03 

BRIDGE  LENGTH:  N  =  31 

-6.048387096774E-03 
-5.645161290323E-03 
-5.2419354g3871E-03 
-4.838709677419E-03 
-4.435483870968E-03 
-4.032258064516E-03 
■3.629032258065E-03 
^3.225806451613E-03 
-2.822580645161E-03 
■2.419354838710E-03 
-2.016129032258E-03 
-1.612903225806E-03 
-1.209677419355E-03 
-8.0645’6129032E-04 
-4.0322580645 16E-04 
0.0 

4.0322580645 16E-04 
8.064516129032E-04 
1.209677419355E-03 
1.612903225806E-03 
2.016129032258E-03 
2.419354838710E-03 
2.822580645161E-03 
3.225806451613E-03 
3.629032258065E-03 
4.0322580645 16E-03 
4.435483870968E-03 
4.8387096774 19E-03 
5.241935483871E-03 
5.645161290323E-03 
6.048387096774E-03 
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BRIDGE  LENGTH:  N  =  33 


-5.^75935828S8E-03 
-5.G1336898395''E-03 
.4.679i44385027E-03 
-4.344919786096E-C3 
-4.CiC695ia7166E"03 
.3.6764705882356-03 
-3.342245989305F-O3 
3.0080?  1390374E-03 
•  2.07379679144  4F,-03 
-2.339572192513E.03 
-2.005347593.583E-03 
-1. 67  i  1229946526^3 
.1.326898395722E.03 
-1.002673796791E.03 
.6.684491978610E.04 
-3.342245989305E.04 
0.0 

3.342245989305E-04 
6.684491978610E.04 
1.002673796791E.03 
1.336898395722E.03 
1.671 1229946.52E-03 
2.005347593583E.03 
2..?39572192513E-0i 
2.673796791444E.03 
3.008021 390374E.03 
3.342245989305E.03 
3.676470588235E.03 
4.0106951 87 166E-03 
4.344919786096E-03 
4.679 144385027E-03 
5.013368983957E.03 
5.347593582888E-03 

BRIDGE  LENGTH:  N  =  35 

.4.761904761905E.03 
-4.481792717087E.03 
.4.201680672269E4)3 
-3.92 156862745 1E.03 
-3.641456582633E4)3 
-3.361344537815E03 
-3.081232492997E.03 
-2.801 120448 179E.03 
-2.521008403361E03 
-2.240896358543E-03 


-1. 9607843 13725E-03 
-1.680672268908E-03 
.1.400560224090E-03 
-1.12C448179272E-03 
-8.403361 344538E-04 
-5.60224O896359E-C4 
-2.801 120448 179E-04 
0.0 

2.801 120448179E-O4 
5.602240896359E-04 
8.403361344538E-04 
1.120448179272E-03 
1  4C0560224090E-03 
1.680672268908E-03 
1.960784313725E-03 
2.240896358543E-03 
2.521008403361E-03 
2.801 120448179E-03 
3.081232492997E-03 
3.361344537815E-03 
3.641456582633E-03 
3.921568627451E-03 
4.201 680672269E-03 
4.481792717087E-03 
4.76J904761905E-03 


No.  of 
Copies 

2 

1 

1 

1 


2 

2 

1 


(linclm.  only)  1 

1 


Organization 


No.  of 

Copies  Organization 


Administrator 

Defense  Technical  Info  Center 
ATTN:  DTIC-DDA 
Cameron  Station 
Alexandria.  VA  22304-6145 

Commander 

U.S.  Army  Materiel  Command 
ATTN:  AMCAM 
5001  Eisenhower  Ave. 

Alexandria,  VA  22333-0001 

Director 

U.S.  Army  Research  Laboratory 
AITN:  AMSRL-D 
2800  Powder  MUl  Rd. 

Adelphi.  MD  20783-1145 

Director 

U.S.  Army  Research  Laboratory 
ATTN:  AMSRL-OP-CI-AD, 

Tech  Publishing 
2800  Powder  Mill  Rd. 

Adelphi,  MD  20783-1145 

Commander 

U.S.  Army  Armament  Research, 
Development,  and  Engineering  Center 
ATTN:  SMCAR-IMI-I 
Picatinny  Arsenal,  NJ  07806-5000 


1  Commander 

U.S.  Army  Missile  Command 
ATTN:  AMSMI-RD-CS-R  (DCX:) 

Redstone  Arsenal.  AL  35898-5010 

1  Commander 

U.S.  Army  Tank-Automotive  Command 
ATTN:  ASQNC-TAC-DIT  (Technical 
Information  Center) 

Warren,  MI  48397-5000 

1  Director 

U.S.  Army  TRADCXH  Analysis  Command 
ATTN:  ATRC-WSR 

White  Sands  Missile  Range,  NM  88002-5302 

1  Commandant 

U.S.  Army  Field  Artillery  School 
ATTN:  ATSF-CSI 
Ft.  Sill.  OK  73503-5000 

(ciajt.  only)  1  Commandant 

U.S.  Army  Infantry  School 
ATTN:  ATSH-CD  (Security  Mgr.) 

Fort  Benning,  GA  31905-5660 

(UntUtt.  only)  1  Commandant 

U.S.  Army  Infantry  School 
ATTN:  ATSH-CD-CSO-OR 
Fort  Benning.  GA  31905-5660 


Commander 

U.S.  Army  Armament  Research, 
Development,  and  Engineering  Center 
ATTN:  SMCAR-TDC 
Picatinny  Arsenal,  NJ  07806- 5(X)0 

Director 

Benet  Weapons  Laboratory 
U.S.  Army  Annament  Research, 
Development,  and  Engineering  Center 
ATTN:  SMCAR-CC3-TL 
WatervUet,NY  12189-4050 

Commander 

U.S.  Army  Rock  Island  Arsenal 
ATTN:  SMCRI-IMC-RT/Tcchnical  Library 
Rock  Island.  IL  61299-5000 

Director 

U.S.  Army  Aviation  Research 
and  Technology  Activity 
ATTN:  SAVRT-R  (Library) 

M/S  219-3 

Ames  Research  Center 
Moffett  Field.  CA  94035-1000 


1  WUMNOI 
EgUnAFB.FL  32542-5000 

Aberdeen  Proving  Ground 

2  Dir,  USAMSAA 
ATTN:  AMXSY-D 

AMXSY-MP,  H.  Cohen 

1  Cdr,  USATECOM 
ATTN:  AMSTE-TC 

1  Dir.  ERDEC 

ATTN:  SCBRD-RT 

1  Cdr.  CBDA 

ATTN:  AMSCB-CI 

1  Dir.  USARL 

ATTN:  AMSRL-SL-I 

10  Dir.  USARL 

ATTN:  AMSRL-OP-CI-B  (Tech  Lib) 
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Intentionally  left  blank. 
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USER  EVALUATION  SHEET/CHANGE  OF  ADDRESS 


This  Laboratory  undertakes  a  continuing  eflbrt  to  improve  the  quality  of  the  reports  it  publishes.  Your 
comments/answers  to  the  items/questions  below  will  aid  us  in  our  efforts. 

1 .  ARL  Report  Number  ARL-TR-36  (Part  IT.)  Date  of  Report  January  1993 _ 

2.  Date  Report  Received _ 

3.  Does  tliis  repxjrt  satisfy  a  need?  (Comment  on  purpose,  related  project,  or  other  area  of  interest  for 

which  the  report  wiU  be  used.) _ 


4.  Specifically,  how  is  the  report  being  used?  (Information  source,  design  data,  procedure,  source  of 
ideas,  etc.)  _ _ 


5.  Has  the  information  in  this  report  led  to  any  quantitative  savings  as  far  as  man-hours  or  dollars  saved, 
operating  costs  avoided,  or  efficiencies  achieved,  etc?  If  so,  please  elaborate. _ 


6.  General  Comments.  What  do  you  think  should  be  changed  to  improve  future  reports?  (Indicate 
changes  to  organization,  technical  content,  format,  etc.) _ 


Organization 


CURRENT  Name 

ADDRESS  _ 

Street  or  P.O.  Box  No. 


City,  State,  Zip  Code 

7.  If  indicating  a  Change  of  Address  or  Address  Correction,  please  provide  the  Cuirent  or  Correct  adt^rcss 
above  and  the  Old  or  Inco-rcct  address  below. 


Organization 

OLD  Name 

ADDRESS  _ 

Street  or  P.O.  Box  No. 

City,  State,  Zip  Code 

(Remove  this  sheet,  fold  as  indicated,  staple  or  tape  closed,  and  mail.) 


